diff --git a/thys/CakeML_Codegen/Rewriting/Rewriting_Nterm.thy b/thys/CakeML_Codegen/Rewriting/Rewriting_Nterm.thy
--- a/thys/CakeML_Codegen/Rewriting/Rewriting_Nterm.thy
+++ b/thys/CakeML_Codegen/Rewriting/Rewriting_Nterm.thy
@@ -1,773 +1,786 @@
 section \<open>Higher-order term rewriting using explicit bound variable names\<close>
 
 theory Rewriting_Nterm
 imports
   Rewriting_Term
   Higher_Order_Terms.Term_to_Nterm
   "../Terms/Strong_Term"
 begin
 
 subsection \<open>Definitions\<close>
 
 type_synonym nrule = "term \<times> nterm"
 
 abbreviation nrule :: "nrule \<Rightarrow> bool" where
 "nrule \<equiv> basic_rule"
 
 fun (in constants) not_shadowing :: "nrule \<Rightarrow> bool" where
 "not_shadowing (lhs, rhs) \<longleftrightarrow> \<not> shadows_consts lhs \<and> \<not> shadows_consts rhs"
 
 locale nrules = constants C_info "heads_of rs" for C_info and rs :: "nrule fset" +
   assumes all_rules: "fBall rs nrule"
   assumes arity: "arity_compatibles rs"
   assumes fmap: "is_fmap rs"
   assumes patterns: "pattern_compatibles rs"
   assumes nonempty: "rs \<noteq> {||}"
   assumes not_shadows: "fBall rs not_shadowing"
   assumes welldefined_rs: "fBall rs (\<lambda>(_, rhs). welldefined rhs)"
 
 
 subsection \<open>Matching and rewriting\<close>
 
 inductive nrewrite :: "nrule fset \<Rightarrow> nterm \<Rightarrow> nterm \<Rightarrow> bool" ("_/ \<turnstile>\<^sub>n/ _ \<longrightarrow>/ _" [50,0,50] 50) for rs where
 step: "r |\<in>| rs \<Longrightarrow> r \<turnstile> t \<rightarrow> u \<Longrightarrow> rs \<turnstile>\<^sub>n t \<longrightarrow> u" |
 beta: "rs \<turnstile>\<^sub>n ((\<Lambda>\<^sub>n x. t) $\<^sub>n t') \<longrightarrow> subst t (fmap_of_list [(x, t')])" |
 "fun": "rs \<turnstile>\<^sub>n t \<longrightarrow> t' \<Longrightarrow> rs \<turnstile>\<^sub>n t $\<^sub>n u \<longrightarrow> t' $\<^sub>n u" |
 arg: "rs \<turnstile>\<^sub>n u \<longrightarrow> u' \<Longrightarrow> rs \<turnstile>\<^sub>n t $\<^sub>n u \<longrightarrow> t $\<^sub>n u'"
 
 global_interpretation nrewrite: rewriting "nrewrite rs" for rs
 by standard (auto intro: nrewrite.intros simp: app_nterm_def)+
 
 abbreviation nrewrite_rt :: "nrule fset \<Rightarrow> nterm \<Rightarrow> nterm \<Rightarrow> bool" ("_/ \<turnstile>\<^sub>n/ _ \<longrightarrow>*/ _" [50,0,50] 50) where
 "nrewrite_rt rs \<equiv> (nrewrite rs)\<^sup>*\<^sup>*"
 
 lemma (in nrules) nrewrite_closed:
   assumes "rs \<turnstile>\<^sub>n t \<longrightarrow> t'" "closed t"
   shows "closed t'"
 using assms proof induction
   case (step r t u)
   obtain lhs rhs where "r = (lhs, rhs)"
     by force
   with step have "nrule (lhs, rhs)"
     using all_rules by blast
   hence "frees rhs |\<subseteq>| frees lhs"
     by simp
   have "(lhs, rhs) \<turnstile> t \<rightarrow> u"
     using step unfolding \<open>r = _\<close> by simp
 
   show ?case
     apply (rule rewrite_step_closed)
       apply fact+
     done
 next
   case beta
   show ?case
     apply simp
     apply (subst closed_except_def)
     apply (subst subst_frees)
     using beta unfolding closed_except_def by auto
 qed (auto simp: closed_except_def)
 
 corollary (in nrules) nrewrite_rt_closed:
   assumes "rs \<turnstile>\<^sub>n t \<longrightarrow>* t'" "closed t"
   shows "closed t'"
 using assms
 by induction (auto intro: nrewrite_closed)
 
 subsection \<open>Translation from @{typ term} to @{typ nterm}\<close>
 
 context begin
 
 private lemma term_to_nterm_all_vars0:
   assumes "wellformed' (length \<Gamma>) t"
   shows "\<exists>T. all_frees (fst (run_state (term_to_nterm \<Gamma> t) x)) |\<subseteq>| fset_of_list \<Gamma> |\<union>| frees t |\<union>| T \<and> fBall T (\<lambda>y. y > x)"
 using assms proof (induction \<Gamma> t arbitrary: x rule: term_to_nterm_induct)
   case (bound \<Gamma> i)
   hence "\<Gamma> ! i |\<in>| fset_of_list \<Gamma>"
     by (simp add: fset_of_list_elem)
   with bound show ?case
     by (auto simp: State_Monad.return_def)
 next
   case (abs \<Gamma> t)
 
   obtain T
     where "all_frees (fst (run_state (term_to_nterm (next x # \<Gamma>) t) (next x))) |\<subseteq>| fset_of_list (next x # \<Gamma>) |\<union>| frees t |\<union>| T"
       and "fBall T ((<) (next x))"
     apply atomize_elim
     apply (rule abs(1))
     using abs by auto
 
   show ?case
     apply (simp add: split_beta create_alt_def)
     apply (rule exI[where x = "finsert (next x) T"])
     apply (intro conjI)
     subgoal by auto
     subgoal using \<open>all_frees (fst (run_state _ (next x))) |\<subseteq>| _\<close> by simp
     subgoal
       apply simp
       apply (rule conjI)
        apply (rule next_ge)
       using \<open>fBall T ((<) (next x))\<close>
       by (metis fBallE fBallI fresh_class.next_ge order.strict_trans)
     done
 next
   case (app \<Gamma> t\<^sub>1 t\<^sub>2 x\<^sub>1)
   obtain t\<^sub>1' x\<^sub>2 where "run_state (term_to_nterm \<Gamma> t\<^sub>1) x\<^sub>1 = (t\<^sub>1', x\<^sub>2)"
     by fastforce
   moreover obtain T\<^sub>1
     where "all_frees (fst (run_state (term_to_nterm \<Gamma> t\<^sub>1) x\<^sub>1)) |\<subseteq>| fset_of_list \<Gamma> |\<union>| frees t\<^sub>1 |\<union>| T\<^sub>1"
       and "fBall T\<^sub>1 ((<) x\<^sub>1)"
     apply atomize_elim
     apply (rule app(1))
     using app by auto
   ultimately have "all_frees t\<^sub>1' |\<subseteq>| fset_of_list \<Gamma> |\<union>| frees t\<^sub>1 |\<union>| T\<^sub>1"
     by simp
 
   obtain T\<^sub>2
     where "all_frees (fst (run_state (term_to_nterm \<Gamma> t\<^sub>2) x\<^sub>2)) |\<subseteq>| fset_of_list \<Gamma> |\<union>| frees t\<^sub>2 |\<union>| T\<^sub>2"
       and "fBall T\<^sub>2 ((<) x\<^sub>2)"
     apply atomize_elim
     apply (rule app(2))
     using app by auto
   moreover obtain t\<^sub>2' x' where "run_state (term_to_nterm \<Gamma> t\<^sub>2) x\<^sub>2 = (t\<^sub>2', x')"
     by fastforce
   ultimately have "all_frees t\<^sub>2' |\<subseteq>| fset_of_list \<Gamma> |\<union>| frees t\<^sub>2 |\<union>| T\<^sub>2"
     by simp
 
   have "x\<^sub>1 \<le> x\<^sub>2"
     apply (rule state_io_relD[OF term_to_nterm_mono])
     apply fact
     done
 
   show ?case
     apply simp
     unfolding \<open>run_state (term_to_nterm \<Gamma> t\<^sub>1) x\<^sub>1 = _\<close>
     apply simp
     unfolding \<open>run_state (term_to_nterm \<Gamma> t\<^sub>2) x\<^sub>2 = _\<close>
     apply simp
     apply (rule exI[where x = "T\<^sub>1 |\<union>| T\<^sub>2"])
     apply (intro conjI)
     subgoal using \<open>all_frees t\<^sub>1' |\<subseteq>| _\<close> by auto
     subgoal using \<open>all_frees t\<^sub>2' |\<subseteq>| _\<close> by auto
     subgoal
       apply auto
       using \<open>fBall T\<^sub>1 ((<) x\<^sub>1)\<close> apply auto[]
       using \<open>fBall T\<^sub>2 ((<) x\<^sub>2)\<close> \<open>x\<^sub>1 \<le> x\<^sub>2\<close>
-      by (meson fBallE less_le_not_le order_trans)
+      by auto
     done
 qed auto
 
 lemma term_to_nterm_all_vars:
   assumes "wellformed t" "fdisjnt (frees t) S"
   shows "fdisjnt (all_frees (fresh_frun (term_to_nterm [] t) (T |\<union>| S))) S"
 proof -
   let ?\<Gamma> = "[]"
   let ?x = "fresh_fNext (T |\<union>| S)"
   from assms have "wellformed' (length ?\<Gamma>) t"
     by simp
   then obtain F
     where "all_frees (fst (run_state (term_to_nterm ?\<Gamma> t) ?x)) |\<subseteq>| fset_of_list ?\<Gamma> |\<union>| frees t |\<union>| F"
       and "fBall F (\<lambda>y. y > ?x)"
     by (metis term_to_nterm_all_vars0)
 
   have "fdisjnt F (T |\<union>| S)" if "S \<noteq> {||}"
     apply (rule fdisjnt_ge_max)
     apply (rule fBall_pred_weaken[OF _ \<open>fBall F (\<lambda>y. y > ?x)\<close>])
     apply (rule less_trans)
      apply (rule fNext_ge_max)
     using that by auto
   show ?thesis
     apply (rule fdisjnt_subset_left)
      apply (subst fresh_frun_def)
      apply (subst fresh_fNext_def[symmetric])
      apply fact
     apply simp
     apply (rule fdisjnt_union_left)
      apply fact
     using \<open>_ \<Longrightarrow> fdisjnt F (T |\<union>| S)\<close> by (auto simp: fdisjnt_alt_def)
 qed
 
 end
 
 fun translate_rule :: "name fset \<Rightarrow> rule \<Rightarrow> nrule" where
 "translate_rule S (lhs, rhs) = (lhs, fresh_frun (term_to_nterm [] rhs) (frees lhs |\<union>| S))"
 
 lemma translate_rule_alt_def:
   "translate_rule S = (\<lambda>(lhs, rhs). (lhs, fresh_frun (term_to_nterm [] rhs) (frees lhs |\<union>| S)))"
 by auto
 
 definition compile' where
 "compile' C_info rs = translate_rule (pre_constants.all_consts C_info (heads_of rs)) |`| rs"
 
 context rules begin
 
 definition compile :: "nrule fset" where
 "compile = translate_rule all_consts |`| rs"
 
 lemma compile'_compile_eq[simp]: "compile' C_info rs = compile"
 unfolding compile'_def compile_def ..
 
 lemma compile_heads: "heads_of compile = heads_of rs"
 unfolding compile_def translate_rule_alt_def head_def[abs_def]
 by force
 
 lemma compile_rules: "nrules C_info compile"
 proof
   have "fBall compile (\<lambda>(lhs, rhs). nrule (lhs, rhs))"
     proof safe
       fix lhs rhs
       assume "(lhs, rhs) |\<in>| compile"
       then obtain rhs'
         where "(lhs, rhs') |\<in>| rs"
           and rhs: "rhs = fresh_frun (term_to_nterm [] rhs') (frees lhs |\<union>| all_consts)"
         unfolding compile_def by force
       then have rule: "rule (lhs, rhs')"
         using all_rules by blast
 
       show "nrule (lhs, rhs)"
         proof
           from rule show "linear lhs" "is_const (fst (strip_comb lhs))" "\<not> is_const lhs" by auto
 
           have "frees rhs |\<subseteq>| frees rhs'"
             unfolding rhs using rule
             by (metis rule.simps term_to_nterm_vars)
           also have "frees rhs' |\<subseteq>| frees lhs"
             using rule by auto
           finally show "frees rhs |\<subseteq>| frees lhs" .
         qed
     qed
 
   thus "fBall compile nrule"
     by fast
 next
   show "arity_compatibles compile"
     proof safe
       fix lhs\<^sub>1 rhs\<^sub>1 lhs\<^sub>2 rhs\<^sub>2
       assume "(lhs\<^sub>1, rhs\<^sub>1) |\<in>| compile" "(lhs\<^sub>2, rhs\<^sub>2) |\<in>| compile"
       then obtain rhs\<^sub>1' rhs\<^sub>2' where "(lhs\<^sub>1, rhs\<^sub>1') |\<in>| rs" "(lhs\<^sub>2, rhs\<^sub>2') |\<in>| rs"
         unfolding compile_def by force
       thus "arity_compatible lhs\<^sub>1 lhs\<^sub>2"
         using arity by (blast dest: fpairwiseD)
     qed
 next
   have "is_fmap rs"
     using fmap by simp
   thus "is_fmap compile"
     unfolding compile_def translate_rule_alt_def
     by (rule is_fmap_image)
 next
   have "pattern_compatibles rs"
     using patterns by simp
   thus "pattern_compatibles compile"
     unfolding compile_def translate_rule_alt_def
     by (auto dest: fpairwiseD)
 next
   show "fdisjnt (heads_of compile) C"
     using disjnt by (simp add: compile_heads)
 next
   have "fBall compile not_shadowing"
     proof safe
       fix lhs rhs
       assume "(lhs, rhs) |\<in>| compile"
       then obtain rhs'
         where "rhs = fresh_frun (term_to_nterm [] rhs') (frees lhs |\<union>| all_consts)"
           and "(lhs, rhs') |\<in>| rs"
         unfolding compile_def translate_rule_alt_def by auto
       hence "rule (lhs, rhs')" "\<not> shadows_consts lhs"
         using all_rules not_shadows by blast+
       moreover hence "wellformed rhs'" "frees rhs' |\<subseteq>| frees lhs" "fdisjnt all_consts (frees lhs)"
         unfolding shadows_consts_def by simp+
 
       moreover have "\<not> shadows_consts rhs"
         apply (subst shadows_consts_def)
         apply simp
         unfolding \<open>rhs = _\<close>
         apply (rule fdisjnt_swap)
         apply (rule term_to_nterm_all_vars)
          apply fact
         apply (rule fdisjnt_subset_left)
          apply fact
         apply (rule fdisjnt_swap)
         apply fact
         done
 
       ultimately show "not_shadowing (lhs, rhs)"
         unfolding compile_heads by simp
     qed
   thus "fBall compile (constants.not_shadowing C_info (heads_of compile))"
     unfolding compile_heads .
 
   have "fBall compile (\<lambda>(_, rhs). welldefined rhs)"
     unfolding compile_heads
     unfolding compile_def ball_simps
     apply (rule fBall_pred_weaken[OF _ welldefined_rs])
     subgoal for x
       apply (cases x)
       apply simp
       apply (subst fresh_frun_def)
       apply (subst term_to_nterm_consts[THEN pred_state_run_state])
       by auto
     done
   thus "fBall compile (\<lambda>(_, rhs). consts rhs |\<subseteq>| pre_constants.all_consts C_info (heads_of compile))"
     unfolding compile_heads .
 next
   show "compile \<noteq> {||}"
     using nonempty unfolding compile_def by auto
 next
   show "distinct all_constructors"
     by (fact distinct_ctr)
 qed
 
 sublocale rules_as_nrules: nrules C_info compile
 by (fact compile_rules)
 
 end
 
 subsection \<open>Correctness of translation\<close>
 
 theorem (in rules) compile_correct:
   assumes "compile \<turnstile>\<^sub>n u \<longrightarrow> u'" "closed u"
   shows "rs \<turnstile> nterm_to_term' u \<longrightarrow> nterm_to_term' u'"
 using assms proof (induction u u')
   case (step r u u')
   moreover obtain pat rhs' where "r = (pat, rhs')"
     by force
   ultimately obtain nenv where "match pat u = Some nenv" "u' = subst rhs' nenv"
     by auto
   then obtain env where "nrelated.P_env [] env nenv" "match pat (nterm_to_term [] u) = Some env"
     by (metis nrelated.match_rel option.exhaust option.rel_distinct(1) option.rel_inject(2))
 
   have "closed_env nenv"
     using step \<open>match pat u = Some nenv\<close> by (intro closed.match)
 
   from step obtain rhs
     where "rhs' = fresh_frun (term_to_nterm [] rhs) (frees pat |\<union>| all_consts)" "(pat, rhs) |\<in>| rs"
     unfolding \<open>r = _\<close> compile_def by auto
   with assms have "rule (pat, rhs)"
     using all_rules by blast
   hence "rhs = nterm_to_term [] rhs'"
     unfolding \<open>rhs' = _\<close>
     by (simp add: term_to_nterm_nterm_to_term fresh_frun_def)
 
   have "compile \<turnstile>\<^sub>n u \<longrightarrow> u'"
     using step by (auto intro: nrewrite.step)
   hence "closed u'"
     by (rule rules_as_nrules.nrewrite_closed) fact
 
   show ?case
     proof (rule rewrite.step)
       show "(pat, rhs) \<turnstile> nterm_to_term [] u \<rightarrow> nterm_to_term [] u'"
         apply (subst nterm_to_term_eq_closed)
          apply fact
         apply simp
         apply (rule exI[where x = env])
         apply (rule conjI)
          apply fact
         unfolding \<open>rhs = _\<close>
         apply (subst nrelated_subst)
            apply fact
           apply fact
         unfolding fdisjnt_alt_def apply simp
         unfolding \<open>u' = subst rhs' nenv\<close> by simp
     qed fact
 next
   case beta
   show ?case
     apply simp
     apply (subst subst_single_eq[symmetric, simplified])
     apply (subst nterm_to_term_subst_replace_bound[where n = 0])
     subgoal using beta by (simp add: closed_except_def)
     subgoal by simp
     subgoal by simp
     subgoal by simp (rule rewrite.beta)
     done
 qed (auto intro: rewrite.intros simp: closed_except_def)
 
 subsection \<open>Completeness of translation\<close>
 
 context rules begin
 
 context
   notes [simp] = closed_except_def fdisjnt_alt_def
 begin
 
 private lemma compile_complete0:
   assumes "rs \<turnstile> t \<longrightarrow> t'" "closed t" "wellformed t"
   obtains u' where "compile \<turnstile>\<^sub>n fst (run_state (term_to_nterm [] t) s) \<longrightarrow> u'" "u' \<approx>\<^sub>\<alpha> fst (run_state (term_to_nterm [] t') s')"
 apply atomize_elim
 using assms proof (induction t t' arbitrary: s s')
   case (step r t t')
   let ?t\<^sub>n = "fst (run_state (term_to_nterm [] t) s)"
   let ?t\<^sub>n' = "fst (run_state (term_to_nterm [] t') s')"
   from step have "closed t" "closed ?t\<^sub>n"
     using term_to_nterm_vars0[where \<Gamma> = "[]"]
     by force+
   from step have "nterm_to_term' ?t\<^sub>n = t"
     by (auto intro!: term_to_nterm_nterm_to_term0)
 
   obtain pat rhs' where "r = (pat, rhs')"
     by fastforce
   with step obtain env' where "match pat t = Some env'" "t' = subst rhs' env'"
     by fastforce
   with \<open>_ = t\<close> have "rel_option (nrelated.P_env []) (match pat t) (match pat (?t\<^sub>n))"
     by (metis nrelated.match_rel)
   with step \<open>_ = Some env'\<close>
     obtain env where "nrelated.P_env [] env' env" "match pat ?t\<^sub>n = Some env"
     by (metis (no_types, lifting) option_rel_Some1)
   with \<open>closed ?t\<^sub>n\<close> have "closed_env env"
     by (blast intro: closed.match)
 
   from step obtain rhs
     where "rhs = fresh_frun (term_to_nterm [] rhs') (frees pat |\<union>| all_consts)" "(pat, rhs) |\<in>| compile"
     unfolding \<open>r = _\<close> compile_def
     by force
   with step have "rule (pat, rhs')"
     unfolding \<open>r = _\<close>
     using all_rules by fast
   hence "nterm_to_term' rhs = rhs'"
     unfolding \<open>rhs = _\<close>
     by (simp add: fresh_frun_def term_to_nterm_nterm_to_term)
   obtain u' where "subst rhs env = u'"
     by simp
   have "t' = nterm_to_term' u'"
     unfolding \<open>t' = _\<close>
     unfolding \<open>_ = rhs'\<close>[symmetric]
     apply (subst nrelated_subst)
        apply fact+
     using \<open>_ = u'\<close>
     by simp+
 
   have "compile \<turnstile>\<^sub>n ?t\<^sub>n \<longrightarrow> u'"
     apply (rule nrewrite.step)
      apply fact
     apply simp
     apply (intro conjI exI)
      apply fact+
     done
   with \<open>closed ?t\<^sub>n\<close> have "closed u'"
     by (blast intro:rules_as_nrules.nrewrite_closed)
   with \<open>t' = nterm_to_term' _\<close> have "u' \<approx>\<^sub>\<alpha> ?t\<^sub>n'"
     by (force intro: nterm_to_term_term_to_nterm[where \<Gamma> = "[]" and \<Gamma>' = "[]",simplified])
 
   show ?case
     apply (intro conjI exI)
      apply (rule nrewrite.step)
       apply fact
      apply simp
      apply (intro conjI exI)
       apply fact+
     done
 next
   case (beta t t')
   let ?name = "next s"
   let ?t\<^sub>n = "fst (run_state (term_to_nterm [?name] t) (?name))"
   let ?t\<^sub>n' = "fst (run_state (term_to_nterm [] t') (snd (run_state (term_to_nterm [?name] t) (?name))))"
 
   from beta have "closed t" "closed (t [t']\<^sub>\<beta>)"  "closed (\<Lambda> t $ t')" "closed  t'"
     using replace_bound_frees
     by fastforce+
   moreover from beta have "wellformed' (Suc 0) t" "wellformed t'"
     by simp+
   ultimately have "t = nterm_to_term [?name] ?t\<^sub>n"
              and "t' = nterm_to_term' ?t\<^sub>n'"
              and *:"frees ?t\<^sub>n = {|?name|} \<or> frees ?t\<^sub>n = fempty"
              and "closed ?t\<^sub>n'"
     using term_to_nterm_vars0[where \<Gamma> = "[?name]"]
     using term_to_nterm_vars0[where \<Gamma> = "[]"]
     by (force simp: term_to_nterm_nterm_to_term0)+
 
   hence **:"t [t']\<^sub>\<beta> = nterm_to_term' (subst_single ?t\<^sub>n ?name ?t\<^sub>n')"
     by (auto simp: nterm_to_term_subst_replace_bound[where n = 0])
 
   from \<open>closed ?t\<^sub>n'\<close> have "closed_env (fmap_of_list [(?name, ?t\<^sub>n')])"
     by auto
 
   show ?case
     apply (rule exI)
     apply (auto simp: split_beta create_alt_def)
      apply (rule nrewrite.beta)
     apply (subst subst_single_eq[symmetric])
     apply (subst **)
     apply (rule nterm_to_term_term_to_nterm[where \<Gamma> = "[]" and \<Gamma>' = "[]", simplified])
     apply (subst subst_single_eq)
     apply (subst subst_frees[OF \<open>closed_env _\<close>])
     using * by force
 next
   case ("fun" t t' u)
   hence "closed  t" "closed u" "closed (t $ u)"
        and wellform:"wellformed t" "wellformed u"
     by fastforce+
   from "fun" obtain u'
     where "compile \<turnstile>\<^sub>n fst (run_state (term_to_nterm [] t) s) \<longrightarrow> u'"
           "u' \<approx>\<^sub>\<alpha> fst (run_state (term_to_nterm [] t') s')"
     by force
   show ?case
     apply (rule exI)
     apply (auto simp: split_beta create_alt_def)
      apply (rule nrewrite.fun)
      apply fact
     apply rule
      apply fact
     apply (subst term_to_nterm_alpha_equiv[of "[]" "[]", simplified])
     using \<open>closed u\<close> \<open>wellformed u\<close> by auto
 next
   case (arg u u' t)
   hence "closed  t" "closed u" "closed (t $ u)"
        and wellform:"wellformed t" "wellformed u"
     by fastforce+
   from arg obtain t'
     where "compile \<turnstile>\<^sub>n fst (run_state (term_to_nterm [] u) (snd (run_state (term_to_nterm [] t) s))) \<longrightarrow> t'"
           "t' \<approx>\<^sub>\<alpha>  fst (run_state (term_to_nterm [] u') (snd (run_state (term_to_nterm [] t) s')))"
     by force
   show ?case
     apply (rule exI)
     apply (auto simp: split_beta create_alt_def)
      apply rule
      apply fact
     apply rule
      apply (subst term_to_nterm_alpha_equiv[of "[]" "[]", simplified])
     using \<open>closed t\<close> \<open>wellformed t\<close> apply force+
     by fact
 qed
 
 lemma compile_complete:
   assumes "rs \<turnstile> t \<longrightarrow> t'" "closed t" "wellformed t"
   obtains u' where "compile \<turnstile>\<^sub>n term_to_nterm' t \<longrightarrow> u'" "u' \<approx>\<^sub>\<alpha> term_to_nterm' t'"
 unfolding term_to_nterm'_def
 using assms by (metis compile_complete0)
 
 end
 
 end
 
 subsection \<open>Splitting into constants\<close>
 
 type_synonym crules = "(term list \<times> nterm) fset"
 type_synonym crule_set = "(name \<times> crules) fset"
 
 abbreviation arity_compatibles :: "(term list \<times> 'a) fset \<Rightarrow> bool" where
 "arity_compatibles \<equiv> fpairwise (\<lambda>(pats\<^sub>1, _) (pats\<^sub>2, _). length pats\<^sub>1 = length pats\<^sub>2)"
 
 lemma arity_compatible_length:
   assumes "arity_compatibles rs" "(pats, rhs) |\<in>| rs"
   shows "length pats = arity rs"
 proof -
   have "fBall rs (\<lambda>(pats\<^sub>1, _). fBall rs (\<lambda>(pats\<^sub>2, _). length pats\<^sub>1 = length pats\<^sub>2))"
     using assms unfolding fpairwise_alt_def by blast
   hence "fBall rs (\<lambda>x. fBall rs (\<lambda>y. (length \<circ> fst) x = (length \<circ> fst) y))"
     by force
   hence "(length \<circ> fst) (pats, rhs) = arity rs"
     using assms(2) unfolding arity_def fthe_elem'_eq by (rule singleton_fset_holds)
   thus ?thesis
     by simp
 qed
 
 locale pre_crules = constants C_info "fst |`| rs" for C_info and rs :: "crule_set"
 
 locale crules = pre_crules +
   assumes fmap: "is_fmap rs"
   assumes nonempty: "rs \<noteq> {||}"
   assumes inner:
     "fBall rs (\<lambda>(_, crs).
       arity_compatibles crs \<and>
       is_fmap crs \<and>
       patterns_compatibles crs \<and>
       crs \<noteq> {||} \<and>
       fBall crs (\<lambda>(pats, rhs).
         linears pats \<and>
         pats \<noteq> [] \<and>
         fdisjnt (freess pats) all_consts \<and>
         \<not> shadows_consts rhs \<and>
         frees rhs |\<subseteq>| freess pats \<and>
         welldefined rhs))"
 
 lemma (in pre_crules) crulesI:
   assumes "\<And>name crs. (name, crs) |\<in>| rs \<Longrightarrow> arity_compatibles crs"
   assumes "\<And>name crs. (name, crs) |\<in>| rs \<Longrightarrow> is_fmap crs"
   assumes "\<And>name crs. (name, crs) |\<in>| rs \<Longrightarrow> patterns_compatibles crs"
   assumes "\<And>name crs. (name, crs) |\<in>| rs \<Longrightarrow> crs \<noteq> {||}"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> linears pats"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> pats \<noteq> []"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> fdisjnt (freess pats) all_consts"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> \<not> shadows_consts rhs"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> frees rhs |\<subseteq>| freess pats"
   assumes "\<And>name crs pats rhs. (name, crs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| crs \<Longrightarrow> welldefined rhs"
   assumes "is_fmap rs" "rs \<noteq> {||}"
   shows "crules C_info rs"
-using assms unfolding crules_axioms_def crules_def
-by (auto simp: prod_fBallI intro: pre_crules_axioms)
+proof unfold_locales
+  show "is_fmap rs"
+    using assms(11) .
+next
+  show "rs \<noteq> {||}"
+    using assms(12) .
+next
+  show "fBall rs (\<lambda>(_, crs). Rewriting_Nterm.arity_compatibles crs \<and> is_fmap crs \<and>
+    patterns_compatibles crs \<and> crs \<noteq> {||} \<and>
+    fBall crs (\<lambda>(pats, rhs). linears pats \<and> pats \<noteq> [] \<and> fdisjnt (freess pats) all_consts \<and>
+      \<not> shadows_consts rhs \<and> frees rhs |\<subseteq>| freess pats \<and> consts rhs |\<subseteq>| all_consts))"
+    using assms(1-10)
+    by (intro prod_BallI conjI) metis+
+qed
 
 lemmas crulesI[intro!] = pre_crules.crulesI[unfolded pre_crules_def]
 
 definition "consts_of" :: "nrule fset \<Rightarrow> crule_set" where
 "consts_of = fgroup_by split_rule"
 
 lemma consts_of_heads: "fst |`| consts_of rs = heads_of rs"
 unfolding consts_of_def
 by (simp add: split_rule_fst comp_def)
 
 lemma (in nrules) consts_rules: "crules C_info (consts_of rs)"
 proof
   have "is_fmap rs"
     using fmap by simp
   thus "is_fmap (consts_of rs)"
     unfolding consts_of_def by auto
 
   show "consts_of rs \<noteq> {||}"
     using nonempty unfolding consts_of_def
     by (meson fgroup_by_nonempty)
 
   show "constants C_info (fst |`| consts_of rs)"
     proof
       show "fdisjnt (fst |`| consts_of rs) C"
         using disjnt by (auto simp: consts_of_heads)
     next
       show "distinct all_constructors"
         by (fact distinct_ctr)
     qed
 
   fix name crs
   assume crs: "(name, crs) |\<in>| consts_of rs"
 
   thus "crs \<noteq> {||}"
     unfolding consts_of_def
     by (meson femptyE fgroup_by_nonempty_inner)
 
   show "arity_compatibles crs" "patterns_compatibles crs"
     proof safe
       fix pats\<^sub>1 rhs\<^sub>1 pats\<^sub>2 rhs\<^sub>2
       assume "(pats\<^sub>1, rhs\<^sub>1) |\<in>| crs" "(pats\<^sub>2, rhs\<^sub>2) |\<in>| crs"
       with crs obtain lhs\<^sub>1 lhs\<^sub>2
         where rs: "(lhs\<^sub>1, rhs\<^sub>1) |\<in>| rs" "(lhs\<^sub>2, rhs\<^sub>2) |\<in>| rs" and
               split: "split_rule (lhs\<^sub>1, rhs\<^sub>1) = (name, (pats\<^sub>1, rhs\<^sub>1))"
                      "split_rule (lhs\<^sub>2, rhs\<^sub>2) = (name, (pats\<^sub>2, rhs\<^sub>2))"
         unfolding consts_of_def by (force simp: split_beta)
 
       hence arity: "arity_compatible lhs\<^sub>1 lhs\<^sub>2"
         using arity by (force dest: fpairwiseD)
 
       from rs have const: "is_const (fst (strip_comb lhs\<^sub>1))" "is_const (fst (strip_comb lhs\<^sub>2))"
         using all_rules by force+
 
       have "name = const_name (fst (strip_comb lhs\<^sub>1))" "name = const_name (fst (strip_comb lhs\<^sub>2))"
         using split by (auto simp: split_beta)
       with const have "fst (strip_comb lhs\<^sub>1) = Const name" "fst (strip_comb lhs\<^sub>2) = Const name"
          apply (fold const_term_def)
         subgoal by simp
         subgoal by fastforce
         done
       hence fst: "fst (strip_comb lhs\<^sub>1) = fst (strip_comb lhs\<^sub>2)"
         by simp
 
       with arity have "length (snd (strip_comb lhs\<^sub>1)) = length (snd (strip_comb lhs\<^sub>2))"
         unfolding arity_compatible_def
         by (simp add: split_beta)
 
       with split show "length pats\<^sub>1 = length pats\<^sub>2"
         by (auto simp: split_beta)
 
       have "pattern_compatible lhs\<^sub>1 lhs\<^sub>2"
         using rs patterns by (auto dest: fpairwiseD)
       moreover have "lhs\<^sub>1 = name $$ pats\<^sub>1"
         using split(1) const(1) by (auto simp: split_beta)
       moreover have "lhs\<^sub>2 = name $$ pats\<^sub>2"
         using split(2) const(2) by (auto simp: split_beta)
       ultimately have "pattern_compatible (name $$ pats\<^sub>1) (name $$ pats\<^sub>2)"
         by simp
       thus "patterns_compatible pats\<^sub>1 pats\<^sub>2"
         using \<open>length pats\<^sub>1 = _\<close> by (auto dest: pattern_compatible_combD)
     qed
 
   show "is_fmap crs"
     proof
       fix pats rhs\<^sub>1 rhs\<^sub>2
       assume "(pats, rhs\<^sub>1) |\<in>| crs" "(pats, rhs\<^sub>2) |\<in>| crs"
       with crs obtain lhs\<^sub>1 lhs\<^sub>2
         where rs: "(lhs\<^sub>1, rhs\<^sub>1) |\<in>| rs" "(lhs\<^sub>2, rhs\<^sub>2) |\<in>| rs" and
               split: "split_rule (lhs\<^sub>1, rhs\<^sub>1) = (name, (pats, rhs\<^sub>1))"
                      "split_rule (lhs\<^sub>2, rhs\<^sub>2) = (name, (pats, rhs\<^sub>2))"
         unfolding consts_of_def by (force simp: split_beta)
 
       have "lhs\<^sub>1 = lhs\<^sub>2"
         proof (rule ccontr)
           assume "lhs\<^sub>1 \<noteq> lhs\<^sub>2"
           then consider (fst) "fst (strip_comb lhs\<^sub>1) \<noteq> fst (strip_comb lhs\<^sub>2)"
                       | (snd) "snd (strip_comb lhs\<^sub>1) \<noteq> snd (strip_comb lhs\<^sub>2)"
             by (metis list_strip_comb)
           thus False
             proof cases
               case fst
               moreover have "is_const (fst (strip_comb lhs\<^sub>1))" "is_const (fst (strip_comb lhs\<^sub>2))"
                 using rs all_rules by force+
               ultimately show ?thesis
                 using split const_name_simps by (fastforce simp: split_beta)
             next
               case snd
               with split show ?thesis
                 by (auto simp: split_beta)
             qed
         qed
 
       with rs show "rhs\<^sub>1 = rhs\<^sub>2"
         using \<open>is_fmap rs\<close> by (auto dest: is_fmapD)
     qed
 
   fix pats rhs
   assume "(pats, rhs) |\<in>| crs"
   then obtain lhs where "(lhs, rhs) |\<in>| rs" "pats = snd (strip_comb lhs)"
     using crs unfolding consts_of_def by (force simp: split_beta)
   hence "nrule (lhs, rhs)"
     using all_rules by blast
   hence "linear lhs" "frees rhs |\<subseteq>| frees lhs"
     by auto
   thus "linears pats"
     unfolding \<open>pats = _\<close> by (intro linears_strip_comb)
 
   have "\<not> is_const lhs" "is_const (fst (strip_comb lhs))"
     using \<open>nrule _\<close> by auto
   thus "pats \<noteq> []"
     unfolding \<open>pats = _\<close> using \<open>linear lhs\<close>
     apply (cases lhs)
         apply (fold app_term_def)
     by (auto split: prod.splits)
 
   from \<open>nrule (lhs, rhs)\<close> have "frees (fst (strip_comb lhs)) = {||}"
     by (cases "fst (strip_comb lhs)") (auto simp: is_const_def)
   hence "frees lhs = freess (snd (strip_comb lhs))"
     by (subst frees_strip_comb) auto
   thus "frees rhs |\<subseteq>| freess pats"
     unfolding \<open>pats = _\<close> using \<open>frees rhs |\<subseteq>| frees lhs\<close> by simp
 
   have "\<not> shadows_consts rhs"
     using \<open>(lhs, rhs) |\<in>| rs\<close> not_shadows
     by force
   thus "\<not> pre_constants.shadows_consts C_info (fst |`| consts_of rs) rhs"
     by (simp add: consts_of_heads)
 
   have "fdisjnt all_consts (frees lhs)"
     using \<open>(lhs, rhs) |\<in>| rs\<close> not_shadows
     by (force simp: shadows_consts_def)
   moreover have "freess pats |\<subseteq>| frees lhs"
     unfolding \<open>pats = _\<close> \<open>frees lhs = _\<close>
     by simp
   ultimately have "fdisjnt (freess pats) all_consts"
     by (metis fdisjnt_subset_right fdisjnt_swap)
 
   thus "fdisjnt (freess pats) (pre_constants.all_consts C_info (fst |`| consts_of rs))"
     by (simp add: consts_of_heads)
 
   show "pre_constants.welldefined C_info (fst |`| consts_of rs) rhs"
     using welldefined_rs \<open>(lhs, rhs) |\<in>| rs\<close>
     by (force simp: consts_of_heads)
 qed
 
 sublocale nrules \<subseteq> nrules_as_crules?: crules C_info "consts_of rs"
 by (fact consts_rules)
 
 subsection \<open>Computability\<close>
 
 export_code
   translate_rule consts_of arity nterm_to_term
   checking Scala
 
-end
\ No newline at end of file
+end
+  
\ No newline at end of file
diff --git a/thys/CakeML_Codegen/Rewriting/Rewriting_Pterm_Elim.thy b/thys/CakeML_Codegen/Rewriting/Rewriting_Pterm_Elim.thy
--- a/thys/CakeML_Codegen/Rewriting/Rewriting_Pterm_Elim.thy
+++ b/thys/CakeML_Codegen/Rewriting/Rewriting_Pterm_Elim.thy
@@ -1,1733 +1,1750 @@
 section \<open>Higher-order term rewriting with explicit pattern matching\<close>
 
 theory Rewriting_Pterm_Elim
 imports
   Rewriting_Nterm
   "../Terms/Pterm"
 begin
 
 subsection \<open>Intermediate rule sets\<close>
 
 type_synonym irules = "(term list \<times> pterm) fset"
 type_synonym irule_set = "(name \<times> irules) fset"
 
 locale pre_irules = constants C_info "fst |`| rs" for C_info and rs :: "irule_set"
 
 locale irules = pre_irules +
   assumes fmap: "is_fmap rs"
   assumes nonempty: "rs \<noteq> {||}"
   assumes inner:
     "fBall rs (\<lambda>(_, irs).
       arity_compatibles irs \<and>
       is_fmap irs \<and>
       patterns_compatibles irs \<and>
       irs \<noteq> {||} \<and>
       fBall irs (\<lambda>(pats, rhs).
         linears pats \<and>
         abs_ish pats rhs \<and>
         closed_except rhs (freess pats) \<and>
         fdisjnt (freess pats) all_consts \<and>
         wellformed rhs \<and>
         \<not> shadows_consts rhs \<and>
         welldefined rhs))"
 
 lemma (in pre_irules) irulesI:
   assumes "\<And>name irs. (name, irs) |\<in>| rs \<Longrightarrow> arity_compatibles irs"
   assumes "\<And>name irs. (name, irs) |\<in>| rs \<Longrightarrow> is_fmap irs"
   assumes "\<And>name irs. (name, irs) |\<in>| rs \<Longrightarrow> patterns_compatibles irs"
   assumes "\<And>name irs. (name, irs) |\<in>| rs \<Longrightarrow> irs \<noteq> {||}"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> linears pats"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> abs_ish pats rhs"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> fdisjnt (freess pats) all_consts"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> closed_except rhs (freess pats)"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> wellformed rhs"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> \<not> shadows_consts rhs"
   assumes "\<And>name irs pats rhs. (name, irs) |\<in>| rs \<Longrightarrow> (pats, rhs) |\<in>| irs \<Longrightarrow> welldefined rhs"
   assumes "is_fmap rs" "rs \<noteq> {||}"
   shows "irules C_info rs"
-using assms unfolding irules_axioms_def irules_def
-by (auto simp: prod_fBallI intro: pre_irules_axioms)
+proof unfold_locales
+  show "is_fmap rs"
+    using assms(12) .
+next
+  show "rs \<noteq> {||}"
+    using assms(13) .
+next
+  show "fBall rs (\<lambda>(_, irs). Rewriting_Nterm.arity_compatibles irs \<and> is_fmap irs \<and>
+    patterns_compatibles irs \<and> irs \<noteq> {||} \<and>
+    fBall irs (\<lambda>(pats, rhs). linears pats \<and> abs_ish pats rhs \<and> closed_except rhs (freess pats) \<and>
+      fdisjnt (freess pats) all_consts \<and> pre_strong_term_class.wellformed rhs \<and>
+      \<not> shadows_consts rhs \<and> consts rhs |\<subseteq>| all_consts))"
+    using assms(1-11)
+    by (intro prod_BallI conjI) metis+
+qed
 
 lemmas irulesI[intro!] = pre_irules.irulesI[unfolded pre_irules_def]
 
 subsubsection \<open>Translation from @{typ nterm} to @{typ pterm}\<close>
 
 fun nterm_to_pterm :: "nterm \<Rightarrow> pterm" where
 "nterm_to_pterm (Nvar s) = Pvar s" |
 "nterm_to_pterm (Nconst s) = Pconst s" |
 "nterm_to_pterm (t\<^sub>1 $\<^sub>n t\<^sub>2) = nterm_to_pterm t\<^sub>1 $\<^sub>p nterm_to_pterm t\<^sub>2" |
 "nterm_to_pterm (\<Lambda>\<^sub>n x. t) = (\<Lambda>\<^sub>p x. nterm_to_pterm t)"
 
 lemma nterm_to_pterm_inj: "nterm_to_pterm x = nterm_to_pterm y \<Longrightarrow> x = y"
 by (induction y arbitrary: x) (auto elim: nterm_to_pterm.elims)
 
 lemma nterm_to_pterm:
   assumes "no_abs t"
   shows "nterm_to_pterm t = convert_term t"
 using assms
 apply induction
 apply auto
 by (auto simp: free_nterm_def free_pterm_def const_nterm_def const_pterm_def app_nterm_def app_pterm_def)
 
 lemma nterm_to_pterm_frees[simp]: "frees (nterm_to_pterm t) = frees t"
 by (induct t) auto
 
 lemma closed_nterm_to_pterm[intro]: "closed_except (nterm_to_pterm t) (frees t)"
 unfolding closed_except_def by simp
 
 lemma (in constants) shadows_nterm_to_pterm[simp]: "shadows_consts (nterm_to_pterm t) = shadows_consts t"
 by (induct t) (auto simp: shadows_consts_def fdisjnt_alt_def)
 
 lemma wellformed_nterm_to_pterm[intro]: "wellformed (nterm_to_pterm t)"
 by (induct t) auto
 
 lemma consts_nterm_to_pterm[simp]: "consts (nterm_to_pterm t) = consts t"
 by (induct t) auto
 
 subsubsection \<open>Translation from @{typ crule_set} to @{typ irule_set}\<close>
 
 definition translate_crules :: "crules \<Rightarrow> irules" where
 "translate_crules = fimage (map_prod id nterm_to_pterm)"
 
 definition compile :: "crule_set \<Rightarrow> irule_set" where
 "compile = fimage (map_prod id translate_crules)"
 
 lemma compile_heads: "fst |`| compile rs = fst |`| rs"
 unfolding compile_def by simp
 
 lemma (in crules) compile_rules: "irules C_info (compile rs)"
 proof
   have "is_fmap rs"
     using fmap by simp
   thus "is_fmap (compile rs)"
     unfolding compile_def map_prod_def id_apply by (rule is_fmap_image)
 
   show "compile rs \<noteq> {||}"
     using nonempty unfolding compile_def by auto
 
   show "constants C_info (fst |`| compile rs)"
     proof
       show "fdisjnt (fst |`| compile rs) C"
         using disjnt unfolding compile_def
         by force
     next
       show "distinct all_constructors"
         by (fact distinct_ctr)
     qed
 
   fix name irs
   assume irs: "(name, irs) |\<in>| compile rs"
   then obtain irs' where "(name, irs') |\<in>| rs" "irs = translate_crules irs'"
     unfolding compile_def by force
   hence "arity_compatibles irs'"
-    using inner by (blast dest: fpairwiseD)
+    using inner
+    by (metis (no_types, lifting) case_prodD)
   thus "arity_compatibles irs"
     unfolding \<open>irs = translate_crules irs'\<close> translate_crules_def
     by (force dest: fpairwiseD)
 
   have "patterns_compatibles irs'"
     using \<open>(name, irs') |\<in>| rs\<close> inner
     by (blast dest: fpairwiseD)
   thus "patterns_compatibles irs"
     unfolding \<open>irs = _\<close> translate_crules_def
     by (auto dest: fpairwiseD)
 
   have "is_fmap irs'"
     using \<open>(name, irs') |\<in>| rs\<close> inner by auto
   thus "is_fmap irs"
     unfolding \<open>irs = translate_crules irs'\<close> translate_crules_def map_prod_def id_apply
     by (rule is_fmap_image)
 
   have "irs' \<noteq> {||}"
     using \<open>(name, irs') |\<in>| rs\<close> inner by auto
   thus "irs \<noteq> {||}"
     unfolding \<open>irs = translate_crules irs'\<close> translate_crules_def by simp
 
   fix pats rhs
   assume "(pats, rhs) |\<in>| irs"
   then obtain rhs' where "(pats, rhs') |\<in>| irs'" "rhs = nterm_to_pterm rhs'"
     unfolding \<open>irs = translate_crules irs'\<close> translate_crules_def by force
   hence "linears pats" "pats \<noteq> []" "frees rhs' |\<subseteq>| freess pats" "\<not> shadows_consts rhs'"
     using fbspec[OF inner \<open>(name, irs') |\<in>| rs\<close>]
     by blast+
 
   show "linears pats" by fact
   show "closed_except rhs (freess pats)"
     unfolding \<open>rhs = nterm_to_pterm rhs'\<close>
     using \<open>frees rhs' |\<subseteq>| freess pats\<close>
     by (metis dual_order.trans closed_nterm_to_pterm closed_except_def)
 
   show "wellformed rhs"
     unfolding \<open>rhs = nterm_to_pterm rhs'\<close> by auto
 
   have "fdisjnt (freess pats) all_consts"
     using \<open>(pats, rhs') |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner
-    by blast
+    by auto
   thus "fdisjnt (freess pats) (pre_constants.all_consts C_info (fst |`| compile rs))"
     unfolding compile_def by simp
 
   have "\<not> shadows_consts rhs"
     unfolding \<open>rhs = _\<close> using \<open>\<not> shadows_consts _\<close> by simp
   thus "\<not> pre_constants.shadows_consts C_info (fst |`| compile rs) rhs"
     unfolding compile_heads .
 
   show "abs_ish pats rhs"
     using \<open>pats \<noteq> []\<close> unfolding abs_ish_def by simp
 
   have "welldefined rhs'"
     using fbspec[OF inner \<open>(name, irs') |\<in>| rs\<close>, simplified]
     using \<open>(pats, rhs') |\<in>| irs'\<close>
     by blast
 
   thus "pre_constants.welldefined C_info (fst |`| compile rs) rhs"
     unfolding compile_def \<open>rhs = _\<close>
     by simp
 qed
 
 sublocale crules \<subseteq> crules_as_irules: irules C_info "compile rs"
 by (fact compile_rules)
 
 subsubsection \<open>Transformation of @{typ irule_set}\<close>
 
 definition transform_irules :: "irules \<Rightarrow> irules" where
 "transform_irules rs = (
   if arity rs = 0 then rs
   else map_prod id Pabs |`| fgroup_by (\<lambda>(pats, rhs). (butlast pats, (last pats, rhs))) rs)"
 
 lemma arity_compatibles_transform_irules:
   assumes "arity_compatibles rs"
   shows "arity_compatibles (transform_irules rs)"
 proof (cases "arity rs = 0")
   case True
   thus ?thesis
     unfolding transform_irules_def using assms by simp
 next
   case False
   let ?rs' = "transform_irules rs"
   let ?f = "\<lambda>(pats, rhs). (butlast pats, (last pats, rhs))"
   let ?grp = "fgroup_by ?f rs"
   have rs': "?rs' = map_prod id Pabs |`| ?grp"
     using False unfolding transform_irules_def by simp
   show ?thesis
     proof safe
       fix pats\<^sub>1 rhs\<^sub>1 pats\<^sub>2 rhs\<^sub>2
       assume "(pats\<^sub>1, rhs\<^sub>1) |\<in>| ?rs'" "(pats\<^sub>2, rhs\<^sub>2) |\<in>| ?rs'"
       then obtain rhs\<^sub>1' rhs\<^sub>2' where "(pats\<^sub>1, rhs\<^sub>1') |\<in>| ?grp" "(pats\<^sub>2, rhs\<^sub>2') |\<in>| ?grp"
         unfolding rs' by auto
       then obtain pats\<^sub>1' pats\<^sub>2' x y \<comment> \<open>dummies\<close>
         where "fst (?f (pats\<^sub>1', x)) = pats\<^sub>1" "(pats\<^sub>1', x) |\<in>| rs"
           and "fst (?f (pats\<^sub>2', y)) = pats\<^sub>2" "(pats\<^sub>2', y) |\<in>| rs"
         by (fastforce simp: split_beta elim: fgroup_byE2)
       hence "pats\<^sub>1 = butlast pats\<^sub>1'" "pats\<^sub>2 = butlast pats\<^sub>2'" "length pats\<^sub>1' = length pats\<^sub>2'"
         using assms by (force dest: fpairwiseD)+
       thus "length pats\<^sub>1 = length pats\<^sub>2"
         by auto
     qed
 qed
 
 lemma arity_transform_irules:
   assumes "arity_compatibles rs" "rs \<noteq> {||}"
   shows "arity (transform_irules rs) = (if arity rs = 0 then 0 else arity rs - 1)"
 proof (cases "arity rs = 0")
   case True
   thus ?thesis
     unfolding transform_irules_def by simp
 next
   case False
   let ?f = "\<lambda>(pats, rhs). (butlast pats, (last pats, rhs))"
   let ?grp = "fgroup_by ?f rs"
   let ?rs' = "map_prod id Pabs |`| ?grp"
 
   have "arity ?rs' = arity rs - 1"
     proof (rule arityI)
       show "fBall ?rs' (\<lambda>(pats, _). length pats = arity rs - 1)"
         proof (rule prod_fBallI)
           fix pats rhs
           assume "(pats, rhs) |\<in>| ?rs'"
           then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
             by force
           then obtain pats' x \<comment> \<open>dummy\<close>
             where "pats = butlast pats'" "(pats', x) |\<in>| rs"
             by (fastforce simp: split_beta elim: fgroup_byE2)
           hence "length pats' = arity rs"
             using assms by (metis arity_compatible_length)
           thus "length pats = arity rs - 1"
             unfolding \<open>pats = butlast pats'\<close> using False by simp
         qed
     next
       show "?rs' \<noteq> {||}"
         using assms by (simp add: fgroup_by_nonempty)
     qed
 
   with False show ?thesis
     unfolding transform_irules_def by simp
 qed
 
 definition transform_irule_set :: "irule_set \<Rightarrow> irule_set" where
 "transform_irule_set = fimage (map_prod id transform_irules)"
 
 lemma transform_irule_set_heads: "fst |`| transform_irule_set rs = fst |`| rs"
 unfolding transform_irule_set_def by simp
 
 lemma (in irules) rules_transform: "irules C_info (transform_irule_set rs)"
 proof
   have "is_fmap rs"
     using fmap by simp
   thus "is_fmap (transform_irule_set rs)"
     unfolding transform_irule_set_def map_prod_def id_apply by (rule is_fmap_image)
 
   show "transform_irule_set rs \<noteq> {||}"
     using nonempty unfolding transform_irule_set_def by auto
 
   show "constants C_info (fst |`| transform_irule_set rs)"
     proof
       show "fdisjnt (fst |`| transform_irule_set rs) C"
         using disjnt unfolding transform_irule_set_def
         by force
     next
       show "distinct all_constructors"
         by (fact distinct_ctr)
     qed
 
   fix name irs
   assume irs: "(name, irs) |\<in>| transform_irule_set rs"
   then obtain irs' where "(name, irs') |\<in>| rs" "irs = transform_irules irs'"
     unfolding transform_irule_set_def by force
   hence "arity_compatibles irs'"
-    using inner by (blast dest: fpairwiseD)
+    using inner
+    by (metis (no_types, lifting) case_prodD)
   thus "arity_compatibles irs"
     unfolding \<open>irs = transform_irules irs'\<close> by (rule arity_compatibles_transform_irules)
 
   have "irs' \<noteq> {||}"
     using \<open>(name, irs') |\<in>| rs\<close> inner by blast
   thus "irs \<noteq> {||}"
     unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
     by (simp add: fgroup_by_nonempty)
 
   let ?f = "\<lambda>(pats, rhs). (butlast pats, (last pats, rhs))"
   let ?grp = "fgroup_by ?f irs'"
 
   have "patterns_compatibles irs'"
     using \<open>(name, irs') |\<in>| rs\<close> inner
     by (blast dest: fpairwiseD)
   show "patterns_compatibles irs"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
         using \<open>patterns_compatibles irs'\<close> by simp
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
 
       show ?thesis
         proof safe
           fix pats\<^sub>1 rhs\<^sub>1 pats\<^sub>2 rhs\<^sub>2
           assume "(pats\<^sub>1, rhs\<^sub>1) |\<in>| irs" "(pats\<^sub>2, rhs\<^sub>2) |\<in>| irs"
           with irs' obtain cs\<^sub>1 cs\<^sub>2 where "(pats\<^sub>1, cs\<^sub>1) |\<in>| ?grp" "(pats\<^sub>2, cs\<^sub>2) |\<in>| ?grp"
             by force
           then obtain pats\<^sub>1' pats\<^sub>2' and x y \<comment> \<open>dummies\<close>
             where "(pats\<^sub>1', x) |\<in>| irs'" "(pats\<^sub>2', y) |\<in>| irs'"
               and "pats\<^sub>1 = butlast pats\<^sub>1'" "pats\<^sub>2 = butlast pats\<^sub>2'"
             unfolding irs'
             by (fastforce elim: fgroup_byE2)
           hence "patterns_compatible pats\<^sub>1' pats\<^sub>2'"
             using \<open>patterns_compatibles irs'\<close> by (auto dest: fpairwiseD)
           thus "patterns_compatible pats\<^sub>1 pats\<^sub>2"
             unfolding \<open>pats\<^sub>1 = _\<close> \<open>pats\<^sub>2 = _\<close>
             by auto
         qed
     qed
 
   have "is_fmap irs'"
     using \<open>(name, irs') |\<in>| rs\<close> inner by blast
   show "is_fmap irs"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
         using \<open>is_fmap irs'\<close> by simp
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
 
       show ?thesis
         proof
           fix pats rhs\<^sub>1 rhs\<^sub>2
           assume "(pats, rhs\<^sub>1) |\<in>| irs" "(pats, rhs\<^sub>2) |\<in>| irs"
           with irs' obtain cs\<^sub>1 cs\<^sub>2
             where "(pats, cs\<^sub>1) |\<in>| ?grp" "rhs\<^sub>1 = Pabs cs\<^sub>1"
               and "(pats, cs\<^sub>2) |\<in>| ?grp" "rhs\<^sub>2 = Pabs cs\<^sub>2"
             by force
           moreover have "is_fmap ?grp"
             by auto
           ultimately show "rhs\<^sub>1 = rhs\<^sub>2"
             by (auto dest: is_fmapD)
         qed
     qed
 
   fix pats rhs
   assume "(pats, rhs) |\<in>| irs"
 
   show "linears pats"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
       then obtain pats' x \<comment> \<open>dummy\<close>
         where "fst (?f (pats', x)) = pats" "(pats', x) |\<in>| irs'"
         by (fastforce simp: split_beta elim: fgroup_byE2)
       hence "pats = butlast pats'"
         by simp
       moreover have "linears pats'"
         using \<open>(pats', x) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner
-        by blast
+        by auto
       ultimately show ?thesis
         by auto
     qed
 
   have "fdisjnt (freess pats) all_consts"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
       then obtain pats' x \<comment> \<open>dummy\<close>
         where "fst (?f (pats', x)) = pats" "(pats', x) |\<in>| irs'"
         by (fastforce simp: split_beta elim: fgroup_byE2)
       hence "pats = butlast pats'"
         by simp
       moreover have "fdisjnt (freess pats') all_consts"
-        using \<open>(pats', x) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by blast
+        using \<open>(pats', x) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by auto
       ultimately show ?thesis
         by (metis subsetI in_set_butlastD freess_subset fdisjnt_subset_left)
     qed
 
   thus "fdisjnt (freess pats) (pre_constants.all_consts C_info (fst |`| transform_irule_set rs))"
     unfolding transform_irule_set_def by simp
 
   show "closed_except rhs (freess pats)"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
 
       show ?thesis
         unfolding \<open>rhs = Pabs cs\<close> closed_except_simps
         proof safe
           fix pat t
           assume "(pat, t) |\<in>| cs"
           then obtain pats' where "(pats', t) |\<in>| irs'" "?f (pats', t) = (pats, (pat, t))"
             using \<open>(pats, cs) |\<in>| ?grp\<close> by auto
           hence "closed_except t (freess pats')"
-            using \<open>(name, irs') |\<in>| rs\<close> inner by blast
+            using \<open>(name, irs') |\<in>| rs\<close> inner by auto
 
           have "pats' \<noteq> []"
             using \<open>arity_compatibles irs'\<close> \<open>(pats', t) |\<in>| irs'\<close> False
             by (metis list.size(3) arity_compatible_length)
           hence "pats' = pats @ [pat]"
             using \<open>?f (pats', t) = (pats, (pat, t))\<close>
             by (fastforce simp: split_beta snoc_eq_iff_butlast)
           hence "freess pats |\<union>| frees pat = freess pats'"
             unfolding freess_def by auto
 
           thus "closed_except t (freess pats |\<union>| frees pat)"
             using \<open>closed_except t (freess pats')\<close> by simp
         qed
     qed
 
   show "wellformed rhs"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
 
       show ?thesis
         unfolding \<open>rhs = Pabs cs\<close>
         proof (rule wellformed_PabsI)
           show "cs \<noteq> {||}"
             using \<open>(pats, cs) |\<in>| ?grp\<close> \<open>irs' \<noteq> {||}\<close>
             by (meson femptyE fgroup_by_nonempty_inner)
         next
           show "is_fmap cs"
             proof
               fix pat t\<^sub>1 t\<^sub>2
               assume "(pat, t\<^sub>1) |\<in>| cs" "(pat, t\<^sub>2) |\<in>| cs"
               then obtain pats\<^sub>1' pats\<^sub>2'
                 where "(pats\<^sub>1', t\<^sub>1) |\<in>| irs'" "?f (pats\<^sub>1', t\<^sub>1) = (pats, (pat, t\<^sub>1))"
                   and "(pats\<^sub>2', t\<^sub>2) |\<in>| irs'" "?f (pats\<^sub>2', t\<^sub>2) = (pats, (pat, t\<^sub>2))"
                 using \<open>(pats, cs) |\<in>| ?grp\<close> by force
               moreover hence "pats\<^sub>1' \<noteq> []" "pats\<^sub>2' \<noteq> []"
                 using \<open>arity_compatibles irs'\<close> False
                 unfolding prod.case
                 by (metis list.size(3) arity_compatible_length)+
               ultimately have "pats\<^sub>1' = pats @ [pat]" "pats\<^sub>2' = pats @ [pat]"
                 unfolding split_beta fst_conv snd_conv
                 by (metis prod.inject snoc_eq_iff_butlast)+
               with \<open>is_fmap irs'\<close> show "t\<^sub>1 = t\<^sub>2"
                 using \<open>(pats\<^sub>1', t\<^sub>1) |\<in>| irs'\<close> \<open>(pats\<^sub>2', t\<^sub>2) |\<in>| irs'\<close>
                 by (blast dest: is_fmapD)
             qed
         next
           show "pattern_compatibles cs"
             proof safe
               fix pat\<^sub>1 rhs\<^sub>1 pat\<^sub>2 rhs\<^sub>2
               assume "(pat\<^sub>1, rhs\<^sub>1) |\<in>| cs" "(pat\<^sub>2, rhs\<^sub>2) |\<in>| cs"
               then obtain pats\<^sub>1' pats\<^sub>2'
                 where "(pats\<^sub>1', rhs\<^sub>1) |\<in>| irs'" "?f (pats\<^sub>1', rhs\<^sub>1) = (pats, (pat\<^sub>1, rhs\<^sub>1))"
                   and "(pats\<^sub>2', rhs\<^sub>2) |\<in>| irs'" "?f (pats\<^sub>2', rhs\<^sub>2) = (pats, (pat\<^sub>2, rhs\<^sub>2))"
                 using \<open>(pats, cs) |\<in>| ?grp\<close>
                 by force
               moreover hence "pats\<^sub>1' \<noteq> []" "pats\<^sub>2' \<noteq> []"
                 using \<open>arity_compatibles irs'\<close> False
                 unfolding prod.case
                 by (metis list.size(3) arity_compatible_length)+
               ultimately have "pats\<^sub>1' = pats @ [pat\<^sub>1]" "pats\<^sub>2' = pats @ [pat\<^sub>2]"
                 unfolding split_beta fst_conv snd_conv
                 by (metis prod.inject snoc_eq_iff_butlast)+
               moreover have "patterns_compatible pats\<^sub>1' pats\<^sub>2'"
                 using \<open>(pats\<^sub>1', rhs\<^sub>1) |\<in>| irs'\<close> \<open>(pats\<^sub>2', rhs\<^sub>2) |\<in>| irs'\<close> \<open>patterns_compatibles irs'\<close>
                 by (auto dest: fpairwiseD)
               ultimately show "pattern_compatible pat\<^sub>1 pat\<^sub>2"
                 by (auto elim: rev_accum_rel_snoc_eqE)
             qed
         next
           fix pat t
           assume "(pat, t) |\<in>| cs"
           then obtain pats' where "(pats', t) |\<in>| irs'" "pat = last pats'"
             using \<open>(pats, cs) |\<in>| ?grp\<close> by auto
           moreover hence "pats' \<noteq> []"
             using \<open>arity_compatibles irs'\<close> False
             by (metis list.size(3) arity_compatible_length)
           ultimately have "pat \<in> set pats'"
             by auto
 
           moreover have "linears pats'"
-            using \<open>(pats', t) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by blast
+            using \<open>(pats', t) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by auto
           ultimately show "linear pat"
             by (metis linears_linear)
 
           show "wellformed t"
-            using \<open>(pats', t) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by blast
+            using \<open>(pats', t) |\<in>| irs'\<close> \<open>(name, irs') |\<in>| rs\<close> inner by auto
         qed
     qed
 
   have "\<not> shadows_consts rhs"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
 
       show ?thesis
         unfolding \<open>rhs = _\<close>
         proof
           assume "shadows_consts (Pabs cs)"
           then obtain pat t where "(pat, t) |\<in>| cs" "shadows_consts t \<or> shadows_consts pat"
             by force
           then obtain pats' where "(pats', t) |\<in>| irs'" "pat = last pats'"
             using \<open>(pats, cs) |\<in>| ?grp\<close> by auto
           moreover hence "pats' \<noteq> []"
             using \<open>arity_compatibles irs'\<close> False
             by (metis list.size(3) arity_compatible_length)
           ultimately have "pat \<in> set pats'"
             by auto
 
           show False
             using \<open>shadows_consts t \<or> shadows_consts pat\<close>
             proof
               assume "shadows_consts t"
               thus False
-                using \<open>(name, irs') |\<in>| rs\<close> \<open>(pats', t) |\<in>| irs'\<close> inner by blast
+                using \<open>(name, irs') |\<in>| rs\<close> \<open>(pats', t) |\<in>| irs'\<close> inner by auto
             next
               assume "shadows_consts pat"
 
               have "fdisjnt (freess pats') all_consts"
-                using \<open>(name, irs') |\<in>| rs\<close> \<open>(pats', t) |\<in>| irs'\<close> inner by blast
+                using \<open>(name, irs') |\<in>| rs\<close> \<open>(pats', t) |\<in>| irs'\<close> inner by auto
               have "fdisjnt (frees pat) all_consts"
                 apply (rule fdisjnt_subset_left)
                  apply (subst freess_single[symmetric])
                  apply (rule freess_subset)
                  apply simp
                  apply fact+
                 done
 
               thus False
                 using \<open>shadows_consts pat\<close>
                 unfolding shadows_consts_def fdisjnt_alt_def by auto
           qed
         qed
     qed
   thus "\<not> pre_constants.shadows_consts C_info (fst |`| transform_irule_set rs) rhs"
     by (simp add: transform_irule_set_heads)
 
   show "abs_ish pats rhs"
     proof (cases "arity irs' = 0")
       case True
       thus ?thesis
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
-        by (smt fBallE split_conv)
+        by auto
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
       thus ?thesis
         unfolding abs_ish_def by (simp add: is_abs_def term_cases_def)
     qed
 
   have "welldefined rhs"
     proof (cases "arity irs' = 0")
       case True
       hence \<open>(pats, rhs) |\<in>| irs'\<close>
         using \<open>(pats, rhs) |\<in>| irs\<close> \<open>(name, irs') |\<in>| rs\<close> inner
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def
         by (smt fBallE split_conv)
       thus ?thesis
         unfolding transform_irule_set_def
         using fbspec[OF inner \<open>(name, irs') |\<in>| rs\<close>, simplified]
         by force
     next
       case False
       hence irs': "irs = map_prod id Pabs |`| ?grp"
         unfolding \<open>irs = transform_irules irs'\<close> transform_irules_def by simp
       then obtain cs where "(pats, cs) |\<in>| ?grp" "rhs = Pabs cs"
         using \<open>(pats, rhs) |\<in>| irs\<close> by force
       show ?thesis
         unfolding \<open>rhs = _\<close>
         apply simp
         apply (rule ffUnion_least)
         unfolding ball_simps
         apply rule
         apply (rename_tac x, case_tac x, hypsubst_thin)
         apply simp
         subgoal premises prems for pat t
           proof -
             from prems obtain pats' where "(pats', t) |\<in>| irs'"
               using \<open>(pats, cs) |\<in>| ?grp\<close> by auto
             hence "welldefined t"
               using fbspec[OF inner \<open>(name, irs') |\<in>| rs\<close>, simplified]
               by blast
             thus ?thesis
               unfolding transform_irule_set_def
               by simp
           qed
         done
     qed
   thus "pre_constants.welldefined C_info (fst |`| transform_irule_set rs) rhs"
     unfolding transform_irule_set_heads .
 qed
 
 
 subsubsection \<open>Matching and rewriting\<close>
 
 definition irewrite_step :: "name \<Rightarrow> term list \<Rightarrow> pterm \<Rightarrow> pterm \<Rightarrow> pterm option" where
 "irewrite_step name pats rhs t = map_option (subst rhs) (match (name $$ pats) t)"
 
 abbreviation irewrite_step' :: "name \<Rightarrow> term list \<Rightarrow> pterm \<Rightarrow> pterm \<Rightarrow> pterm \<Rightarrow> bool" ("_, _, _ \<turnstile>\<^sub>i/ _ \<rightarrow>/ _" [50,0,50] 50) where
 "name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> u \<equiv> irewrite_step name pats rhs t = Some u"
 
 lemma irewrite_stepI:
   assumes "match (name $$ pats) t = Some env" "subst rhs env = u"
   shows "name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> u"
 using assms unfolding irewrite_step_def by simp
 
 inductive irewrite :: "irule_set \<Rightarrow> pterm \<Rightarrow> pterm \<Rightarrow> bool" ("_/ \<turnstile>\<^sub>i/ _ \<longrightarrow>/ _" [50,0,50] 50) for irs where
 step: "\<lbrakk> (name, rs) |\<in>| irs; (pats, rhs) |\<in>| rs; name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> t' \<rbrakk> \<Longrightarrow> irs \<turnstile>\<^sub>i t \<longrightarrow> t'" |
 beta: "\<lbrakk> c |\<in>| cs; c \<turnstile> t \<rightarrow> t' \<rbrakk> \<Longrightarrow> irs \<turnstile>\<^sub>i Pabs cs $\<^sub>p t \<longrightarrow> t'" |
 "fun": "irs \<turnstile>\<^sub>i t \<longrightarrow> t' \<Longrightarrow> irs \<turnstile>\<^sub>i t $\<^sub>p u \<longrightarrow> t' $\<^sub>p u" |
 arg: "irs \<turnstile>\<^sub>i u \<longrightarrow> u' \<Longrightarrow> irs \<turnstile>\<^sub>i t $\<^sub>p u \<longrightarrow> t $\<^sub>p u'"
 
 global_interpretation irewrite: rewriting "irewrite rs" for rs
 by standard (auto intro: irewrite.intros simp: app_pterm_def)+
 
 abbreviation irewrite_rt :: "irule_set \<Rightarrow> pterm \<Rightarrow> pterm \<Rightarrow> bool" ("_/ \<turnstile>\<^sub>i/ _ \<longrightarrow>*/ _" [50,0,50] 50) where
 "irewrite_rt rs \<equiv> (irewrite rs)\<^sup>*\<^sup>*"
 
 lemma (in irules) irewrite_closed:
   assumes "rs \<turnstile>\<^sub>i t \<longrightarrow> u" "closed t"
   shows "closed u"
 using assms proof induction
   case (step name rs pats rhs t t')
   then obtain env where "match (name $$ pats) t = Some env" "t' = subst rhs env"
     unfolding irewrite_step_def by auto
   hence "closed_env env"
     using step by (auto intro: closed.match)
 
   show ?case
     unfolding \<open>t' = _\<close>
     apply (subst closed_except_def)
     apply (subst subst_frees)
      apply fact
     apply (subst match_dom)
      apply fact
     apply (subst frees_list_comb)
     apply simp
     apply (subst closed_except_def[symmetric])
     using inner step by blast
 next
   case (beta c cs t t')
   then obtain pat rhs where "c = (pat, rhs)"
     by (cases c) auto
   with beta obtain env where "match pat t = Some env" "t' = subst rhs env"
     by auto
   moreover have "closed t"
     using beta unfolding closed_except_def by simp
   ultimately have "closed_env env"
     using beta by (auto intro: closed.match)
 
   show ?case
     unfolding \<open>t' = subst rhs env\<close>
     apply (subst closed_except_def)
     apply (subst subst_frees)
      apply fact
     apply (subst match_dom)
      apply fact
     apply simp
     apply (subst closed_except_def[symmetric])
     using inner beta \<open>c = _\<close> by (auto simp: closed_except_simps)
 qed (auto simp: closed_except_def)
 
 corollary (in irules) irewrite_rt_closed:
   assumes "rs \<turnstile>\<^sub>i t \<longrightarrow>* u" "closed t"
   shows "closed u"
 using assms by induction (auto intro: irewrite_closed)
 
 subsubsection \<open>Correctness of translation\<close>
 
 abbreviation irelated :: "nterm \<Rightarrow> pterm \<Rightarrow> bool" ("_ \<approx>\<^sub>i _" [0,50] 50) where
 "n \<approx>\<^sub>i p \<equiv> nterm_to_pterm n = p"
 
 global_interpretation irelated: term_struct_rel_strong irelated
 by standard
    (auto simp: app_pterm_def app_nterm_def const_pterm_def const_nterm_def elim: nterm_to_pterm.elims)
 
 lemma irelated_vars: "t \<approx>\<^sub>i u \<Longrightarrow> frees t = frees u"
 by auto
 
 lemma irelated_no_abs:
   assumes "t \<approx>\<^sub>i u"
   shows "no_abs t \<longleftrightarrow> no_abs u"
 using assms
 apply (induction arbitrary: t)
  apply (auto elim!: nterm_to_pterm.elims)
    apply (fold const_nterm_def const_pterm_def free_nterm_def free_pterm_def app_pterm_def app_nterm_def)
 by auto
 
 lemma irelated_subst:
   assumes "t \<approx>\<^sub>i u" "irelated.P_env nenv penv"
   shows "subst t nenv \<approx>\<^sub>i subst u penv"
 using assms proof (induction arbitrary: nenv penv u rule: nterm_to_pterm.induct)
   case (1 s)
   then show ?case
     by (auto elim!: fmrel_cases[where x = s])
 next
   case 4
   from 4(2)[symmetric] show ?case
     apply simp
     apply (rule 4)
      apply simp
     using 4(3)
     by (simp add: fmrel_drop)
 qed auto
 
 lemma related_irewrite_step:
   assumes "name, pats, nterm_to_pterm rhs \<turnstile>\<^sub>i u \<rightarrow> u'" "t \<approx>\<^sub>i u"
   obtains t' where "unsplit_rule (name, pats, rhs) \<turnstile> t \<rightarrow> t'" "t' \<approx>\<^sub>i u'"
 proof -
   let ?rhs' = "nterm_to_pterm rhs"
   let ?x = "name $$ pats"
 
   from assms obtain env where "match ?x u = Some env" "u' = subst ?rhs' env"
     unfolding irewrite_step_def by blast
   then obtain nenv where "match ?x t = Some nenv" "irelated.P_env nenv env"
     using assms
     by (metis Option.is_none_def not_None_eq option.rel_distinct(1) option.sel rel_option_unfold irelated.match_rel)
 
   show thesis
     proof
       show "unsplit_rule (name, pats, rhs) \<turnstile> t \<rightarrow> subst rhs nenv"
         using \<open>match ?x t = _\<close> by auto
     next
       show "subst rhs nenv \<approx>\<^sub>i u'"
         unfolding \<open>u' = _\<close> using \<open>irelated.P_env nenv env\<close>
         by (auto intro: irelated_subst)
     qed
 qed
 
 theorem (in nrules) compile_correct:
   assumes "compile (consts_of rs) \<turnstile>\<^sub>i u \<longrightarrow> u'" "t \<approx>\<^sub>i u" "closed t"
   obtains t' where "rs \<turnstile>\<^sub>n t \<longrightarrow> t'" "t' \<approx>\<^sub>i u'"
 using assms(1-3) proof (induction arbitrary: t thesis rule: irewrite.induct)
   case (step name irs pats rhs u u')
   then obtain crs where "irs = translate_crules crs" "(name, crs) |\<in>| consts_of rs"
     unfolding compile_def by force
   moreover with step obtain rhs' where "rhs = nterm_to_pterm rhs'" "(pats, rhs') |\<in>| crs"
     unfolding translate_crules_def by force
   ultimately obtain rule where "split_rule rule = (name, (pats, rhs'))" "rule |\<in>| rs"
     unfolding consts_of_def by blast
   hence "nrule rule"
     using all_rules by blast
 
   obtain t' where "unsplit_rule (name, pats, rhs') \<turnstile> t \<rightarrow> t'" "t' \<approx>\<^sub>i u'"
     using \<open>name, pats, rhs \<turnstile>\<^sub>i u \<rightarrow> u'\<close> \<open>t \<approx>\<^sub>i u\<close> unfolding \<open>rhs = nterm_to_pterm rhs'\<close>
     by (elim related_irewrite_step)
   hence "rule \<turnstile> t \<rightarrow> t'"
     using \<open>nrule rule\<close> \<open>split_rule rule = (name, (pats, rhs'))\<close>
     by (metis unsplit_split)
 
   show ?case
     proof (rule step.prems)
       show "rs \<turnstile>\<^sub>n t \<longrightarrow> t'"
         apply (rule nrewrite.step)
          apply fact
         apply fact
         done
     next
       show "t' \<approx>\<^sub>i u'"
         by fact
     qed
 next
   case (beta c cs u u')
   then obtain pat rhs where "c = (pat, rhs)" "(pat, rhs) |\<in>| cs"
     by (cases c) auto
   obtain v w where "t = v $\<^sub>n w" "v \<approx>\<^sub>i Pabs cs" "w \<approx>\<^sub>i u"
     using \<open>t \<approx>\<^sub>i Pabs cs $\<^sub>p u\<close> by (auto elim: nterm_to_pterm.elims)
   obtain x nrhs irhs where "v = (\<Lambda>\<^sub>n x. nrhs)" "cs = {| (Free x, irhs) |}" "nrhs \<approx>\<^sub>i irhs"
     using \<open>v \<approx>\<^sub>i Pabs cs\<close> by (auto elim: nterm_to_pterm.elims)
   hence "t = (\<Lambda>\<^sub>n x. nrhs) $\<^sub>n w" "\<Lambda>\<^sub>n x. nrhs \<approx>\<^sub>i \<Lambda>\<^sub>p x. irhs"
     unfolding \<open>t = v $\<^sub>n w\<close> using \<open>v \<approx>\<^sub>i Pabs cs\<close> by auto
 
   have "pat = Free x" "rhs = irhs"
     using \<open>cs = {| (Free x, irhs) |}\<close> \<open>(pat, rhs) |\<in>| cs\<close> by auto
   hence "(Free x, irhs) \<turnstile> u \<rightarrow> u'"
     using beta \<open>c = _\<close> by simp
   hence "u' = subst irhs (fmap_of_list [(x, u)])"
     by simp
 
   show ?case
     proof (rule beta.prems)
       show "rs \<turnstile>\<^sub>n t \<longrightarrow> subst nrhs (fmap_of_list [(x, w)])"
         unfolding \<open>t = (\<Lambda>\<^sub>n x. nrhs) $\<^sub>n w\<close>
         by (rule nrewrite.beta)
     next
       show "subst nrhs (fmap_of_list [(x, w)]) \<approx>\<^sub>i u'"
         unfolding \<open>u' = subst irhs _\<close>
         apply (rule irelated_subst)
          apply fact
         apply simp
         apply rule
          apply rule
         apply fact
         done
     qed
 next
   case ("fun" v v' u)
   obtain w x where "t = w $\<^sub>n x" "w \<approx>\<^sub>i v" "x \<approx>\<^sub>i u"
     using \<open>t \<approx>\<^sub>i v $\<^sub>p u\<close> by (auto elim: nterm_to_pterm.elims)
   with "fun" obtain w' where "rs \<turnstile>\<^sub>n w \<longrightarrow> w'" "w' \<approx>\<^sub>i v'"
     unfolding closed_except_def by auto
 
   show ?case
     proof (rule fun.prems)
       show "rs \<turnstile>\<^sub>n t \<longrightarrow> w' $\<^sub>n x"
         unfolding \<open>t = w $\<^sub>n x\<close>
         by (rule nrewrite.fun) fact
     next
       show "w' $\<^sub>n x \<approx>\<^sub>i v' $\<^sub>p u"
         by auto fact+
     qed
 next
   case (arg u u' v)
   obtain w x where "t = w $\<^sub>n x" "w \<approx>\<^sub>i v" "x \<approx>\<^sub>i u"
     using \<open> t \<approx>\<^sub>i v $\<^sub>p u\<close> by (auto elim: nterm_to_pterm.elims)
   with arg obtain x' where "rs \<turnstile>\<^sub>n x \<longrightarrow> x'" "x' \<approx>\<^sub>i u'"
     unfolding closed_except_def by auto
 
   show ?case
     proof (rule arg.prems)
       show "rs \<turnstile>\<^sub>n t \<longrightarrow> w $\<^sub>n x'"
         unfolding \<open>t = w $\<^sub>n x\<close>
         by (rule nrewrite.arg) fact
     next
       show "w $\<^sub>n x' \<approx>\<^sub>i v $\<^sub>p u'"
         by auto fact+
     qed
 qed
 
 corollary (in nrules) compile_correct_rt:
   assumes "compile (consts_of rs) \<turnstile>\<^sub>i u \<longrightarrow>* u'" "t \<approx>\<^sub>i u" "closed t"
   obtains t' where "rs \<turnstile>\<^sub>n t \<longrightarrow>* t'" "t' \<approx>\<^sub>i u'"
 using assms proof (induction arbitrary: thesis t) (* FIXME clone of transform_correct_rt, maybe locale? *)
   case (step u' u'')
 
   obtain t' where "rs \<turnstile>\<^sub>n t \<longrightarrow>* t'" "t' \<approx>\<^sub>i u'"
     using step by blast
 
   obtain t'' where "rs \<turnstile>\<^sub>n t' \<longrightarrow>* t''" "t'' \<approx>\<^sub>i u''"
     proof (rule compile_correct)
       show "compile (consts_of rs) \<turnstile>\<^sub>i u' \<longrightarrow> u''" "t' \<approx>\<^sub>i u'"
         by fact+
     next
       show "closed t'"
         using \<open>rs \<turnstile>\<^sub>n t \<longrightarrow>* t'\<close> \<open>closed t\<close>
         by (rule nrewrite_rt_closed)
     qed blast
 
   show ?case
     proof (rule step.prems)
       show "rs \<turnstile>\<^sub>n t \<longrightarrow>* t''"
         using \<open>rs \<turnstile>\<^sub>n t \<longrightarrow>* t'\<close> \<open>rs \<turnstile>\<^sub>n t' \<longrightarrow>* t''\<close> by auto
     qed fact
 qed blast
 
 subsubsection \<open>Completeness of translation\<close>
 
 lemma (in nrules) compile_complete:
   assumes "rs \<turnstile>\<^sub>n t \<longrightarrow> t'" "closed t"
   shows "compile (consts_of rs) \<turnstile>\<^sub>i nterm_to_pterm t \<longrightarrow> nterm_to_pterm t'"
   using assms proof induction
   case (step r t t')
   then obtain pat rhs' where "r = (pat, rhs')"
     by force
   then have "(pat, rhs') |\<in>| rs" "(pat, rhs') \<turnstile> t \<rightarrow> t'"
     using step by blast+
   then have "nrule (pat, rhs')"
     using all_rules by blast
   then obtain name pats where "(name, (pats, rhs')) = split_rule r" "pat = name $$ pats"
     unfolding split_rule_def \<open>r = _\<close>
     apply atomize_elim
     by (auto simp: split_beta)
 
   obtain crs where "(name, crs) |\<in>| consts_of rs" "(pats, rhs') |\<in>| crs"
     using step \<open>_ = split_rule r\<close> \<open>r = _\<close>
     by (metis consts_of_def fgroup_by_complete fst_conv snd_conv)
   then obtain irs where "irs = translate_crules crs"
     by blast
   then have "(name, irs) |\<in>| compile (consts_of rs)"
     unfolding compile_def
     using \<open>(name, _) |\<in>| _\<close>
     by (metis fimageI id_def map_prod_simp)
   obtain rhs where "rhs = nterm_to_pterm rhs'" "(pats, rhs) |\<in>| irs"
     using \<open>irs = _\<close> \<open>_ |\<in>| crs\<close>
     unfolding translate_crules_def
     by (metis fimageI id_def map_prod_simp)
 
   from step obtain env' where "match pat t = Some env'" "t' = subst rhs' env'"
     unfolding \<open>r = _\<close> using rewrite_step.simps
     by force
   then obtain env where "match pat (nterm_to_pterm t) = Some env" "irelated.P_env env' env"
     by (metis irelated.match_rel option_rel_Some1)
   then have "subst rhs env = nterm_to_pterm t'"
     unfolding \<open>t' = _\<close>
     apply -
     apply (rule sym)
     apply (rule irelated_subst)
     unfolding \<open>rhs = _\<close>
     by auto
 
   have "name, pats, rhs \<turnstile>\<^sub>i nterm_to_pterm t \<rightarrow> nterm_to_pterm t'"
     apply (rule irewrite_stepI)
     using \<open>match _ _ = Some env\<close> unfolding \<open>pat = _\<close>
      apply assumption
     by fact
 
   show ?case
     by rule fact+
 next
   case (beta x t t')
   obtain c where "c = (Free x, nterm_to_pterm t)"
     by blast
   from beta have "closed (nterm_to_pterm t')"
     using closed_nterm_to_pterm[where t = t']
     unfolding closed_except_def
     by auto
   show ?case
     apply simp
     apply rule
     using \<open>c = _\<close>
     by (fastforce intro: irelated_subst[THEN sym])+
 next
   case ("fun" t t' u)
   show ?case
     apply simp
     apply rule
     apply (rule "fun")
     using "fun"
     unfolding closed_except_def
     apply simp
     done
 next
   case (arg u u' t)
   show ?case
     apply simp
     apply rule
     apply (rule arg)
     using arg
     unfolding closed_except_def
     by simp
 qed
 
 
 subsubsection \<open>Correctness of transformation\<close>
 
 abbreviation irules_deferred_matches :: "pterm list \<Rightarrow> irules \<Rightarrow> (term \<times> pterm) fset" where
 "irules_deferred_matches args \<equiv> fselect
   (\<lambda>(pats, rhs). map_option (\<lambda>env. (last pats, subst rhs env)) (matchs (butlast pats) args))"
 
 context irules begin
 
 inductive prelated :: "pterm \<Rightarrow> pterm \<Rightarrow> bool" ("_ \<approx>\<^sub>p _" [0,50] 50) where
 const: "Pconst x \<approx>\<^sub>p Pconst x" |
 var: "Pvar x \<approx>\<^sub>p Pvar x" |
 app: "t\<^sub>1 \<approx>\<^sub>p u\<^sub>1 \<Longrightarrow> t\<^sub>2 \<approx>\<^sub>p u\<^sub>2 \<Longrightarrow> t\<^sub>1 $\<^sub>p t\<^sub>2 \<approx>\<^sub>p u\<^sub>1 $\<^sub>p u\<^sub>2" |
 pat: "rel_fset (rel_prod (=) prelated) cs\<^sub>1 cs\<^sub>2 \<Longrightarrow> Pabs cs\<^sub>1 \<approx>\<^sub>p Pabs cs\<^sub>2" |
 "defer":
   "(name, rsi) |\<in>| rs \<Longrightarrow> 0 < arity rsi \<Longrightarrow>
    rel_fset (rel_prod (=) prelated) (irules_deferred_matches args rsi) cs \<Longrightarrow>
    list_all closed args \<Longrightarrow>
    name $$ args \<approx>\<^sub>p Pabs cs"
 
 inductive_cases prelated_absE[consumes 1, case_names pat "defer"]: "t \<approx>\<^sub>p Pabs cs"
 
 lemma prelated_refl[intro!]: "t \<approx>\<^sub>p t"
 proof (induction t)
   case Pabs
   thus ?case
     by (auto simp: snds.simps intro!: prelated.pat rel_fset_refl_strong rel_prod.intros)
 qed (auto intro: prelated.intros)
 
 sublocale prelated: term_struct_rel prelated
 by standard (auto simp: const_pterm_def app_pterm_def intro: prelated.intros elim: prelated.cases)
 
 lemma prelated_pvars:
   assumes "t \<approx>\<^sub>p u"
   shows "frees t = frees u"
 using assms proof (induction rule: prelated.induct)
   case (pat cs\<^sub>1 cs\<^sub>2)
   show ?case
     apply simp
     apply (rule arg_cong[where f = ffUnion])
     apply (rule rel_fset_image_eq)
      apply fact
     apply auto
     done
 next
   case ("defer" name rsi args cs)
 
   {
     fix pat t
     assume "(pat, t) |\<in>| cs"
     with "defer" obtain t'
       where "(pat, t') |\<in>| irules_deferred_matches args rsi" "frees t = frees t'"
       by (auto elim: rel_fsetE2)
     then obtain pats rhs env
       where "pat = last pats" "(pats, rhs) |\<in>| rsi"
         and "matchs (butlast pats) args = Some env" "t' = subst rhs env"
       by auto
 
     have "closed_except rhs (freess pats)" "linears pats"
-      using \<open>(pats, rhs) |\<in>| rsi\<close> \<open>(name, rsi) |\<in>| rs\<close> inner by blast+
+      using \<open>(pats, rhs) |\<in>| rsi\<close> \<open>(name, rsi) |\<in>| rs\<close> inner by auto
 
     have "arity_compatibles rsi"
-      using "defer" inner by (blast dest: fpairwiseD)
+      using "defer" inner
+      by (metis (no_types, lifting) case_prodD)
     have "length pats > 0"
       by (subst arity_compatible_length) fact+
     hence "pats = butlast pats @ [last pats]"
       by simp
 
     note \<open>frees t = frees t'\<close>
     also have "frees t' = frees rhs - fmdom env"
       unfolding \<open>t' = _\<close>
       apply (rule subst_frees)
       apply (rule closed.matchs)
        apply fact+
       done
     also have "\<dots> = frees rhs - freess (butlast pats)"
       using \<open>matchs _ _ = _\<close> by (metis matchs_dom)
     also have "\<dots> |\<subseteq>| freess pats - freess (butlast pats)"
       using \<open>closed_except _ _\<close>
       by (auto simp: closed_except_def)
     also have "\<dots> = frees (last pats) |-| freess (butlast pats)"
       by (subst \<open>pats = _\<close>) (simp add: funion_fminus)
     also have "\<dots> = frees (last pats)"
       proof (rule fminus_triv)
         have "fdisjnt (freess (butlast pats)) (freess [last pats])"
           using \<open>linears pats\<close> \<open>pats = _\<close>
           by (metis linears_appendD)
         thus "frees (last pats) |\<inter>| freess (butlast pats) = {||}"
           by (fastforce simp: fdisjnt_alt_def)
       qed
     also have "\<dots> = frees pat" unfolding \<open>pat = _\<close> ..
     finally have "frees t |\<subseteq>| frees pat" .
   }
   hence "closed (Pabs cs)"
     unfolding closed_except_simps
     by (auto simp: closed_except_def)
   moreover have "closed (name $$ args)"
     unfolding closed_list_comb by fact
   ultimately show ?case
     unfolding closed_except_def by simp
 qed auto
 
 corollary prelated_closed: "t \<approx>\<^sub>p u \<Longrightarrow> closed t \<longleftrightarrow> closed u"
 unfolding closed_except_def
 by (auto simp: prelated_pvars)
 
 lemma prelated_no_abs_right:
   assumes "t \<approx>\<^sub>p u" "no_abs u"
   shows "t = u"
 using assms
 apply (induction rule: prelated.induct)
     apply auto
  apply (fold app_pterm_def)
  apply auto
 done
 
 corollary env_prelated_refl[intro!]: "prelated.P_env env env"
 by (auto intro: fmap.rel_refl)
 
 text \<open>
   The following, more general statement does not hold:
     @{prop "t \<approx>\<^sub>p u \<Longrightarrow> rel_option prelated.P_env (match x t) (match x u)"}
   If @{text t} and @{text u} are related because of the @{thm [source=true] prelated.defer} rule,
   they have completely different shapes.
   Establishing @{prop "is_abs t \<longleftrightarrow> is_abs u"} as a precondition would rule out this case, but at
   the same time be too restrictive.
 
   Instead, we use @{thm prelated.related_match}.
 \<close>
 
 lemma prelated_subst:
   assumes "t\<^sub>1 \<approx>\<^sub>p t\<^sub>2" "prelated.P_env env\<^sub>1 env\<^sub>2"
   shows "subst t\<^sub>1 env\<^sub>1 \<approx>\<^sub>p subst t\<^sub>2 env\<^sub>2"
 using assms proof (induction arbitrary: env\<^sub>1 env\<^sub>2 rule: prelated.induct)
   case (var x)
   thus ?case
     proof (cases rule: fmrel_cases[where x = x])
       case none
       thus ?thesis
         by (auto intro: prelated.var)
     next
       case (some t u)
       thus ?thesis
         by simp
     qed
 next
   case (pat cs\<^sub>1 cs\<^sub>2)
   let ?drop = "\<lambda>env. \<lambda>(pat::term). fmdrop_fset (frees pat) env"
   from pat have "prelated.P_env (?drop env\<^sub>1 pat) (?drop env\<^sub>2 pat)" for pat
     by blast
   with pat show ?case
     by (auto intro!: prelated.pat rel_fset_image)
 next
   case ("defer" name rsi args cs)
   have "name $$ args \<approx>\<^sub>p Pabs cs"
     apply (rule prelated.defer)
        apply fact+
      apply (rule fset.rel_mono_strong)
       apply fact
      apply force
     apply fact
     done
   moreover have "closed (name $$ args)"
     unfolding closed_list_comb by fact
   ultimately have "closed (Pabs cs)"
     by (metis prelated_closed)
 
   let ?drop = "\<lambda>env. \<lambda>pat. fmdrop_fset (frees pat) env"
   let ?f = "\<lambda>env. (\<lambda>(pat, rhs). (pat, subst rhs (?drop env pat)))"
 
   have "name $$ args \<approx>\<^sub>p Pabs (?f env\<^sub>2 |`| cs)"
     proof (rule prelated.defer)
       show "(name, rsi) |\<in>| rs" "0 < arity rsi" "list_all closed args"
         using "defer" by auto
     next
       {
         fix pat\<^sub>1 rhs\<^sub>1
         fix pat\<^sub>2 rhs\<^sub>2
         assume "(pat\<^sub>2, rhs\<^sub>2) |\<in>| cs"
         assume "pat\<^sub>1 = pat\<^sub>2" "rhs\<^sub>1 \<approx>\<^sub>p rhs\<^sub>2"
         have "rhs\<^sub>1 \<approx>\<^sub>p subst rhs\<^sub>2 (fmdrop_fset (frees pat\<^sub>2) env\<^sub>2)"
           by (subst subst_closed_pabs) fact+
       }
       hence "rel_fset (rel_prod (=) prelated) (id |`| irules_deferred_matches args rsi) (?f env\<^sub>2 |`| cs)"
         by (force intro!: rel_fset_image[OF \<open>rel_fset _ _ _\<close>])
 
       thus "rel_fset (rel_prod (=) prelated) (irules_deferred_matches args rsi) (?f env\<^sub>2 |`| cs)"
         by simp
     qed
 
   moreover have "map (\<lambda>t. subst t env\<^sub>1) args = args"
     apply (rule map_idI)
     apply (rule subst_closed_id)
     using "defer" by (simp add: list_all_iff)
 
   ultimately show ?case
     by (simp add: subst_list_comb)
 qed (auto intro: prelated.intros)
 
 lemma prelated_step:
   assumes "name, pats, rhs \<turnstile>\<^sub>i u \<rightarrow> u'" "t \<approx>\<^sub>p u"
   obtains t' where "name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> t'" "t' \<approx>\<^sub>p u'"
 proof -
   let ?lhs = "name $$ pats"
   from assms obtain env where "match ?lhs u = Some env" "u' = subst rhs env"
     unfolding irewrite_step_def by blast
   then obtain env' where "match ?lhs t = Some env'" "prelated.P_env env' env"
     using assms by (auto elim: prelated.related_match)
   hence "subst rhs env' \<approx>\<^sub>p subst rhs env"
     using assms by (auto intro: prelated_subst)
 
   show thesis
     proof
       show "name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> subst rhs env'"
         unfolding irewrite_step_def using \<open>match ?lhs t = Some env'\<close>
         by simp
     next
       show "subst rhs env' \<approx>\<^sub>p u'"
         unfolding \<open>u' = subst rhs env\<close>
         by fact
     qed
 qed
 
 (* FIXME write using relators *)
 lemma prelated_beta: \<comment> \<open>same problem as @{thm [source=true] prelated.related_match}\<close>
   assumes "(pat, rhs\<^sub>2) \<turnstile> t\<^sub>2 \<rightarrow> u\<^sub>2" "rhs\<^sub>1 \<approx>\<^sub>p rhs\<^sub>2" "t\<^sub>1 \<approx>\<^sub>p t\<^sub>2"
   obtains u\<^sub>1 where "(pat, rhs\<^sub>1) \<turnstile> t\<^sub>1 \<rightarrow> u\<^sub>1" "u\<^sub>1 \<approx>\<^sub>p u\<^sub>2"
 proof -
   from assms obtain env\<^sub>2 where "match pat t\<^sub>2 = Some env\<^sub>2" "u\<^sub>2 = subst rhs\<^sub>2 env\<^sub>2"
     by auto
   with assms obtain env\<^sub>1 where "match pat t\<^sub>1 = Some env\<^sub>1" "prelated.P_env env\<^sub>1 env\<^sub>2"
     by (auto elim: prelated.related_match)
   with assms have "subst rhs\<^sub>1 env\<^sub>1 \<approx>\<^sub>p subst rhs\<^sub>2 env\<^sub>2"
     by (auto intro: prelated_subst)
 
   show thesis
     proof
       show "(pat, rhs\<^sub>1) \<turnstile> t\<^sub>1 \<rightarrow> subst rhs\<^sub>1 env\<^sub>1"
         using \<open>match pat t\<^sub>1 = _\<close> by simp
     next
       show "subst rhs\<^sub>1 env\<^sub>1 \<approx>\<^sub>p u\<^sub>2"
         unfolding \<open>u\<^sub>2 = _\<close> by fact
     qed
 qed
 
 theorem transform_correct:
   assumes "transform_irule_set rs \<turnstile>\<^sub>i u \<longrightarrow> u'" "t \<approx>\<^sub>p u" "closed t"
   obtains t' where "rs \<turnstile>\<^sub>i t \<longrightarrow>* t'" \<comment> \<open>zero or one step\<close> and "t' \<approx>\<^sub>p u'"
 using assms(1-3) proof (induction arbitrary: t thesis rule: irewrite.induct)
   case (beta c cs\<^sub>2 u\<^sub>2 x\<^sub>2')
   obtain v u\<^sub>1 where "t = v $\<^sub>p u\<^sub>1" "v \<approx>\<^sub>p Pabs cs\<^sub>2" "u\<^sub>1 \<approx>\<^sub>p u\<^sub>2"
     using \<open>t \<approx>\<^sub>p Pabs cs\<^sub>2 $\<^sub>p u\<^sub>2\<close> by cases
   with beta have "closed u\<^sub>1"
     by (simp add: closed_except_def)
 
   obtain pat rhs\<^sub>2 where "c = (pat, rhs\<^sub>2)" by (cases c) auto
 
   from \<open>v \<approx>\<^sub>p Pabs cs\<^sub>2\<close> show ?case
     proof (cases rule: prelated_absE)
       case (pat cs\<^sub>1)
       with beta \<open>c = _\<close> obtain rhs\<^sub>1 where "(pat, rhs\<^sub>1) |\<in>| cs\<^sub>1" "rhs\<^sub>1 \<approx>\<^sub>p rhs\<^sub>2"
         by (auto elim: rel_fsetE2)
       with beta obtain x\<^sub>1' where "(pat, rhs\<^sub>1) \<turnstile> u\<^sub>1 \<rightarrow> x\<^sub>1'" "x\<^sub>1' \<approx>\<^sub>p x\<^sub>2'"
         using \<open>u\<^sub>1 \<approx>\<^sub>p u\<^sub>2\<close> assms \<open>c = _\<close>
         by (auto elim: prelated_beta simp del: rewrite_step.simps)
 
       show ?thesis
         proof (rule beta.prems)
           show "rs \<turnstile>\<^sub>i t \<longrightarrow>* x\<^sub>1'"
             unfolding \<open>t = _\<close> \<open>v = _\<close>
             by (intro r_into_rtranclp irewrite.beta) fact+
         next
           show "x\<^sub>1' \<approx>\<^sub>p x\<^sub>2'"
             by fact
       qed
     next
       case ("defer" name rsi args)
       with beta \<open>c = _\<close> obtain rhs\<^sub>1' where "(pat, rhs\<^sub>1') |\<in>| irules_deferred_matches args rsi" "rhs\<^sub>1' \<approx>\<^sub>p rhs\<^sub>2"
         by (auto elim: rel_fsetE2)
       then obtain env\<^sub>a rhs\<^sub>1 pats
         where "matchs (butlast pats) args = Some env\<^sub>a" "pat = last pats" "rhs\<^sub>1' = subst rhs\<^sub>1 env\<^sub>a"
           and "(pats, rhs\<^sub>1) |\<in>| rsi"
         by auto
       hence "linears pats"
-        using \<open>(name, rsi) |\<in>| rs\<close> inner unfolding irules_def by blast
+        using \<open>(name, rsi) |\<in>| rs\<close> inner unfolding irules_def by auto
 
       have "arity_compatibles rsi"
-        using "defer" inner by (blast dest: fpairwiseD)
+        using "defer" inner
+        by (metis (no_types, lifting) case_prodD)
       have "length pats > 0"
         by (subst arity_compatible_length) fact+
       hence "pats = butlast pats @ [pat]"
         unfolding \<open>pat = _\<close> by simp
 
       from beta \<open>c = _\<close> obtain env\<^sub>b where "match pat u\<^sub>2 = Some env\<^sub>b" "x\<^sub>2' = subst rhs\<^sub>2 env\<^sub>b"
         by fastforce
       with \<open>u\<^sub>1 \<approx>\<^sub>p u\<^sub>2\<close> obtain env\<^sub>b' where "match pat u\<^sub>1 = Some env\<^sub>b'" "prelated.P_env env\<^sub>b' env\<^sub>b"
         by (metis prelated.related_match)
 
       have "closed_env env\<^sub>a"
         by (rule closed.matchs) fact+
       have "closed_env env\<^sub>b'"
         apply (rule closed.matchs[where pats = "[pat]" and ts = "[u\<^sub>1]"])
          apply simp
          apply fact
         apply simp
         apply fact
         done
 
       have "fmdom env\<^sub>a = freess (butlast pats)"
         by (rule matchs_dom) fact
       moreover have "fmdom env\<^sub>b' = frees pat"
         by (rule match_dom) fact
       moreover have "fdisjnt (freess (butlast pats)) (frees pat)"
         using \<open>pats = _\<close> \<open>linears pats\<close>
         by (metis freess_single linears_appendD(3))
       ultimately have "fdisjnt (fmdom env\<^sub>a) (fmdom env\<^sub>b')"
         by simp
 
       show ?thesis
         proof (rule beta.prems)
           have "rs \<turnstile>\<^sub>i name $$ args $\<^sub>p u\<^sub>1 \<longrightarrow> subst rhs\<^sub>1' env\<^sub>b'"
             proof (rule irewrite.step)
               show "(name, rsi) |\<in>| rs" "(pats, rhs\<^sub>1) |\<in>| rsi"
                 by fact+
             next
               show "name, pats, rhs\<^sub>1 \<turnstile>\<^sub>i name $$ args $\<^sub>p u\<^sub>1 \<rightarrow> subst rhs\<^sub>1' env\<^sub>b'"
                 apply (rule irewrite_stepI)
                  apply (fold app_pterm_def)
                  apply (subst list_comb_snoc)
                  apply (subst matchs_match_list_comb)
                  apply (subst \<open>pats = _\<close>)
                  apply (rule matchs_appI)
                   apply fact
                  apply simp
                  apply fact
                 unfolding \<open>rhs\<^sub>1' = _\<close>
                 apply (rule subst_indep')
                  apply fact+
                 done
             qed
           thus "rs \<turnstile>\<^sub>i t \<longrightarrow>* subst rhs\<^sub>1' env\<^sub>b'"
             unfolding \<open>t = _\<close> \<open>v = _\<close>
             by (rule r_into_rtranclp)
         next
           show "subst rhs\<^sub>1' env\<^sub>b' \<approx>\<^sub>p x\<^sub>2'"
             unfolding \<open>x\<^sub>2' = _\<close>
             by (rule prelated_subst) fact+
         qed
     qed
 next
   case (step name rs\<^sub>2 pats rhs u u')
   then obtain rs\<^sub>1 where "rs\<^sub>2 = transform_irules rs\<^sub>1" "(name, rs\<^sub>1) |\<in>| rs"
     unfolding transform_irule_set_def by force
   hence "arity_compatibles rs\<^sub>1"
-    using inner by (blast dest: fpairwiseD)
+    using inner
+    by (metis (no_types, lifting) case_prodD)
 
   show ?case
     proof (cases "arity rs\<^sub>1 = 0")
       case True
       hence "rs\<^sub>2 = rs\<^sub>1"
         unfolding \<open>rs\<^sub>2 = _\<close> transform_irules_def by simp
       with step have "(pats, rhs) |\<in>| rs\<^sub>1"
         by simp
       from step obtain t' where "name, pats, rhs \<turnstile>\<^sub>i t \<rightarrow> t'" "t' \<approx>\<^sub>p u'"
         using assms
         by (auto elim: prelated_step)
 
       show ?thesis
         proof (rule step.prems)
           show "rs \<turnstile>\<^sub>i t \<longrightarrow>* t'"
             by (intro conjI exI r_into_rtranclp irewrite.step) fact+
         qed fact
     next
       let ?f = "\<lambda>(pats, rhs). (butlast pats, last pats, rhs)"
       let ?grp = "fgroup_by ?f rs\<^sub>1"
 
       case False
       hence "rs\<^sub>2 = map_prod id Pabs |`| ?grp"
         unfolding \<open>rs\<^sub>2 = _\<close> transform_irules_def by simp
       with step obtain cs where "rhs = Pabs cs" "(pats, cs) |\<in>| ?grp"
         by force
 
       from step obtain env\<^sub>2 where "match (name $$ pats) u = Some env\<^sub>2" "u' = subst rhs env\<^sub>2"
         unfolding irewrite_step_def by auto
       then obtain args\<^sub>2 where "u = name $$ args\<^sub>2" "matchs pats args\<^sub>2 = Some env\<^sub>2"
         by (auto elim: match_list_combE)
       with step obtain args\<^sub>1 where "t = name $$ args\<^sub>1" "list_all2 prelated args\<^sub>1 args\<^sub>2"
         by (auto elim: prelated.list_combE)
 
       then obtain env\<^sub>1 where "matchs pats args\<^sub>1 = Some env\<^sub>1" "prelated.P_env env\<^sub>1 env\<^sub>2"
         using \<open>matchs pats args\<^sub>2 = _\<close> by (metis prelated.related_matchs)
       hence "fmdom env\<^sub>1 = freess pats"
         by (auto simp: matchs_dom)
 
       obtain cs' where "u' = Pabs cs'"
         unfolding \<open>u' = _\<close> \<open>rhs = _\<close> by auto
 
       hence "cs' = (\<lambda>(pat, rhs). (pat, subst rhs (fmdrop_fset (frees pat) env\<^sub>2 ))) |`| cs"
         using \<open>u' = subst rhs env\<^sub>2\<close> unfolding \<open>rhs = _\<close>
         by simp
 
       show ?thesis
         proof (rule step.prems)
           show "rs \<turnstile>\<^sub>i t \<longrightarrow>* t"
             by (rule rtranclp.rtrancl_refl)
         next
           show "t \<approx>\<^sub>p u'"
             unfolding \<open>u' = Pabs cs'\<close> \<open>t = _\<close>
             proof (intro prelated.defer rel_fsetI; safe?)
               show "(name, rs\<^sub>1) |\<in>| rs"
                 by fact
             next
               show "0 < arity rs\<^sub>1"
                 using False by simp
             next
               show "list_all closed args\<^sub>1"
                 using \<open>closed t\<close> unfolding \<open>t = _\<close> closed_list_comb .
             next
               fix pat rhs'
               assume "(pat, rhs') |\<in>| irules_deferred_matches args\<^sub>1 rs\<^sub>1"
               then obtain pats' rhs env
                 where "(pats', rhs) |\<in>| rs\<^sub>1"
                   and "matchs (butlast pats') args\<^sub>1 = Some env" "pat = last pats'" "rhs' = subst rhs env"
                 by auto
               with False have "pats' \<noteq> []"
                 using \<open>arity_compatibles rs\<^sub>1\<close>
                 by (metis list.size(3) arity_compatible_length)
               hence "butlast pats' @ [last pats'] = pats'"
                 by simp
 
               from \<open>(pats, cs) |\<in>| ?grp\<close> obtain pats\<^sub>e rhs\<^sub>e
                 where "(pats\<^sub>e, rhs\<^sub>e) |\<in>| rs\<^sub>1" "pats = butlast pats\<^sub>e"
                 by (auto elim: fgroup_byE2)
 
               have "patterns_compatible (butlast pats') pats"
                 unfolding \<open>pats = _\<close>
                 apply (rule rev_accum_rel_butlast)
                 using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(pats\<^sub>e, rhs\<^sub>e) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| rs\<close> inner
                 by (blast dest: fpairwiseD)
 
               interpret irules': irules C_info "transform_irule_set rs" by (rule rules_transform)
 
               have "butlast pats' = pats" "env = env\<^sub>1"
                  apply (rule matchs_compatible_eq)
                 subgoal by fact
                 subgoal
                   apply (rule linears_butlastI)
-                  using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| rs\<close> inner by blast
+                  using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| rs\<close> inner by auto
                 subgoal
                   using \<open>(pats, _) |\<in>| rs\<^sub>2\<close> \<open>(name, rs\<^sub>2) |\<in>| transform_irule_set rs\<close>
-                  using irules'.inner by blast
+                  using irules'.inner by auto
                   apply fact+
                 subgoal
                   apply (rule matchs_compatible_eq)
                       apply fact
                      apply (rule linears_butlastI)
                   using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| rs\<close> inner
-                     apply blast
+                  apply auto []
                   using \<open>(pats, _) |\<in>| rs\<^sub>2\<close> \<open>(name, rs\<^sub>2) |\<in>| transform_irule_set rs\<close>
-                  using irules'.inner apply blast
+                  using irules'.inner apply auto[]
                   by fact+
                 done
 
               let ?rhs_subst = "\<lambda>env. subst rhs (fmdrop_fset (frees pat) env)"
 
               have "fmdom env\<^sub>2 = freess pats"
                 using \<open>match (_ $$ _) _ = Some env\<^sub>2\<close>
                 by (simp add: match_dom)
 
               show "fBex cs' (rel_prod (=) prelated (pat, rhs'))"
                 unfolding \<open>rhs' = _\<close>
                 proof (rule fBexI, rule rel_prod.intros)
                   have "fdisjnt (freess (butlast pats')) (frees (last pats'))"
                     apply (subst freess_single[symmetric])
                     apply (rule linears_appendD)
                     apply (subst \<open>butlast pats' @ [last pats'] = pats'\<close>)
                     using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| rs\<close> inner
-                    by blast
+                    by auto
 
                   show "subst rhs env \<approx>\<^sub>p ?rhs_subst env\<^sub>2"
                     apply (rule prelated_subst)
                      apply (rule prelated_refl)
                     unfolding fmfilter_alt_defs
                     apply (subst fmfilter_true)
                     subgoal premises prems for x y
                       using fmdomI[OF prems]
                       unfolding \<open>pat = _\<close> \<open>fmdom env\<^sub>2 = _\<close>
                       apply (subst (asm) \<open>butlast pats' = pats\<close>[symmetric])
                       using \<open>fdisjnt (freess (butlast pats')) (frees (last pats'))\<close>
                       by (auto simp: fdisjnt_alt_def)
                     subgoal
                       unfolding \<open>env = _\<close>
                       by fact
                     done
                 next
                   have "(pat, rhs) |\<in>| cs"
                     unfolding \<open>pat = _\<close>
                     apply (rule fgroup_byD[where a = "(x, y)" for x y])
                       apply fact
                      apply simp
                      apply (intro conjI)
                        apply fact
                       apply (rule refl)+
                     apply fact
                     done
                   thus "(pat, ?rhs_subst env\<^sub>2) |\<in>| cs'"
                     unfolding \<open>cs' = _\<close> by force
                 qed simp
             next
               fix pat rhs'
               assume "(pat, rhs') |\<in>| cs'"
               then obtain rhs
                 where "(pat, rhs) |\<in>| cs"
                   and "rhs' = subst rhs (fmdrop_fset (frees pat) env\<^sub>2 )"
                 unfolding \<open>cs' = _\<close> by auto
               with \<open>(pats, cs) |\<in>| ?grp\<close> obtain pats'
                 where "(pats', rhs) |\<in>| rs\<^sub>1" "pats = butlast pats'" "pat = last pats'"
                 by auto
               with False have "length pats' \<noteq> 0"
                 using \<open>arity_compatibles _\<close> by (metis arity_compatible_length)
               hence "pats' = pats @ [pat]"
                 unfolding \<open>pats = _\<close> \<open>pat = _\<close> by auto
               moreover have "linears pats'"
-                using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| _\<close> inner by blast
+                using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>(name, rs\<^sub>1) |\<in>| _\<close> inner by auto
               ultimately have "fdisjnt (fmdom env\<^sub>1) (frees pat)"
                 unfolding \<open>fmdom env\<^sub>1 = _\<close>
                 by (auto dest: linears_appendD)
 
               let ?rhs_subst = "\<lambda>env. subst rhs (fmdrop_fset (frees pat) env)"
 
               show "fBex (irules_deferred_matches args\<^sub>1 rs\<^sub>1) (\<lambda>e. rel_prod (=) prelated e (pat, rhs'))"
                 unfolding \<open>rhs' = _\<close>
                 proof (rule fBexI, rule rel_prod.intros)
                   show "?rhs_subst env\<^sub>1 \<approx>\<^sub>p ?rhs_subst env\<^sub>2"
                     using \<open>prelated.P_env env\<^sub>1 env\<^sub>2\<close> inner
                     by (auto intro: prelated_subst)
                 next
                   have "matchs (butlast pats') args\<^sub>1 = Some env\<^sub>1"
                     using \<open>matchs pats args\<^sub>1 = _\<close> \<open>pats = _\<close> by simp
                   moreover have "subst rhs env\<^sub>1 = ?rhs_subst env\<^sub>1"
                     apply (rule arg_cong[where f = "subst rhs"])
                     unfolding fmfilter_alt_defs
                     apply (rule fmfilter_true[symmetric])
                     using \<open>fdisjnt (fmdom env\<^sub>1) _\<close>
                     by (auto simp: fdisjnt_alt_def intro: fmdomI)
                   ultimately show "(pat, ?rhs_subst env\<^sub>1) |\<in>| irules_deferred_matches args\<^sub>1 rs\<^sub>1"
                     using \<open>(pats', rhs) |\<in>| rs\<^sub>1\<close> \<open>pat = last pats'\<close>
                     by auto
                 qed simp
             qed
         qed
     qed
 next
   case ("fun" v v' u)
   obtain w x where "t = w $\<^sub>p x" "w \<approx>\<^sub>p v" "x \<approx>\<^sub>p u" "closed w"
     using \<open>t \<approx>\<^sub>p v $\<^sub>p u\<close> \<open>closed t\<close> by cases (auto simp: closed_except_def)
   with "fun" obtain w' where "rs \<turnstile>\<^sub>i w \<longrightarrow>* w'" "w' \<approx>\<^sub>p v'"
     by blast
 
   show ?case
     proof (rule fun.prems)
       show "rs \<turnstile>\<^sub>i t \<longrightarrow>* w' $\<^sub>p x"
         unfolding \<open>t = _\<close>
         by (intro irewrite.rt_comb[unfolded app_pterm_def] rtranclp.rtrancl_refl) fact
     next
       show "w' $\<^sub>p x \<approx>\<^sub>p v' $\<^sub>p u"
         by (rule prelated.app) fact+
     qed
 next
   case (arg u u' v)
   obtain w x where "t = w $\<^sub>p x" "w \<approx>\<^sub>p v" "x \<approx>\<^sub>p u" "closed x"
     using \<open>t \<approx>\<^sub>p v $\<^sub>p u\<close> \<open>closed t\<close> by cases (auto simp: closed_except_def)
   with arg obtain x' where "rs \<turnstile>\<^sub>i x \<longrightarrow>* x'" "x' \<approx>\<^sub>p u'"
     by blast
 
   show ?case
     proof (rule arg.prems)
       show "rs \<turnstile>\<^sub>i t \<longrightarrow>* w $\<^sub>p x'"
         unfolding \<open>t = w $\<^sub>p x\<close>
         by (intro irewrite.rt_comb[unfolded app_pterm_def] rtranclp.rtrancl_refl) fact
     next
       show "w $\<^sub>p x' \<approx>\<^sub>p v $\<^sub>p u'"
         by (rule prelated.app) fact+
     qed
 qed
 
 end
 
 subsubsection \<open>Completeness of transformation\<close>
 
 lemma (in irules) transform_completeness:
   assumes "rs \<turnstile>\<^sub>i t \<longrightarrow> t'" "closed t"
   shows "transform_irule_set rs \<turnstile>\<^sub>i t \<longrightarrow>* t'"
 using assms proof induction
   case (step name irs' pats' rhs' t t')
   then obtain irs where "irs = transform_irules irs'" "(name, irs) |\<in>| transform_irule_set rs"
     unfolding transform_irule_set_def
     by (metis fimageI id_apply map_prod_simp)
   show ?case
   proof (cases "arity irs' = 0")
     case True
     hence "irs = irs'"
       unfolding \<open>irs = _\<close>
       unfolding transform_irules_def
       by simp
     with step have "(pats', rhs') |\<in>| irs" "name, pats', rhs' \<turnstile>\<^sub>i t \<rightarrow> t'"
       by blast+
     have "transform_irule_set rs \<turnstile>\<^sub>i t \<longrightarrow>* t'"
       apply (rule r_into_rtranclp)
       apply rule
       by fact+
 
     show ?thesis by fact
   next
     let ?f = "\<lambda>(pats, rhs). (butlast pats, last pats, rhs)"
     let ?grp = "fgroup_by ?f irs'"
     note closed_except_def [simp add]
     case False
     then have "irs = map_prod id Pabs |`| ?grp"
       unfolding \<open>irs = _\<close>
       unfolding transform_irules_def
       by simp
     with False have "irs = transform_irules irs'"
       unfolding transform_irules_def
       by simp
     obtain pat pats where "pat = last pats'" "pats = butlast pats'"
       by blast
     from step False have "length pats' \<noteq> 0"
       using arity_compatible_length inner
-      by (smt fBallE prod.simps(2))
+      by (smt (verit, ccfv_threshold) case_prodD)
     then have "pats' = pats @ [pat]"
       unfolding \<open>pat = _\<close> \<open>pats = _\<close>
       by simp
     from step have "linears pats'"
-      using inner fBallE
-      by (metis (mono_tags, lifting) old.prod.case)
+      using inner by auto
     then have "fdisjnt (freess pats) (frees pat)"
       unfolding \<open>pats' = _\<close>
       using linears_appendD(3) freess_single
       by force
 
     from step obtain cs where "(pats, cs) |\<in>| ?grp"
       unfolding \<open>pats = _\<close>
       by (metis (no_types, lifting) fgroup_by_complete fst_conv prod.simps(2))
     with step have "(pat, rhs') |\<in>| cs"
       unfolding \<open>pat = _\<close> \<open>pats = _\<close>
       by (meson fgroup_byD old.prod.case)
     have "(pats, Pabs cs) |\<in>| irs"
       using \<open>irs = map_prod id Pabs |`| ?grp\<close> \<open>(pats, cs) |\<in>| _\<close>
       by (metis (no_types, lifting) eq_snd_iff fst_conv fst_map_prod id_def rev_fimage_eqI snd_map_prod)
     from step obtain env' where "match (name $$ pats') t = Some env'" "subst rhs' env' = t'"
       using irewrite_step_def by auto
     have "name $$ pats' = (name $$ pats) $ pat"
       unfolding \<open>pats' = _\<close>
       by (simp add: app_term_def)
     then obtain t\<^sub>0 t\<^sub>1 env\<^sub>0 env\<^sub>1 where "t = t\<^sub>0 $\<^sub>p t\<^sub>1" "match (name $$ pats) t\<^sub>0 = Some env\<^sub>0" "match pat t\<^sub>1 = Some env\<^sub>1" "env' = env\<^sub>0 ++\<^sub>f env\<^sub>1"
       using match_appE_split[OF \<open>match (name $$ pats') _ = _\<close>[unfolded \<open>name $$ pats' = _\<close>], unfolded app_pterm_def]
       by blast
     with step have "closed t\<^sub>0" "closed t\<^sub>1"
       by auto
     then have "closed_env env\<^sub>0" "closed_env env\<^sub>1"
       using match_vars[OF \<open>match _ t\<^sub>0 = _\<close>] match_vars[OF \<open>match _ t\<^sub>1 = _\<close>]
       unfolding closed_except_def
       by auto
     obtain t\<^sub>0' where "subst (Pabs cs) env\<^sub>0 = t\<^sub>0'"
       by blast
     then obtain cs' where "t\<^sub>0' = Pabs cs'" "cs' = ((\<lambda>(pat, rhs). (pat, subst rhs (fmdrop_fset (frees pat) env\<^sub>0))) |`| cs)"
       using subst_pterm.simps(3) by blast
     obtain rhs where "subst rhs' (fmdrop_fset (frees pat) env\<^sub>0) = rhs"
       by blast
     then have "(pat, rhs) |\<in>| cs'"
       unfolding \<open>cs' = _\<close>
       using \<open>_ |\<in>| cs\<close>
       by (metis (mono_tags, lifting) old.prod.case rev_fimage_eqI)
     have "env\<^sub>0 ++\<^sub>f env\<^sub>1 = (fmdrop_fset (frees pat) env\<^sub>0) ++\<^sub>f env\<^sub>1"
       apply (subst fmadd_drop_left_dom[symmetric])
       using \<open>match pat _ = _\<close> match_dom
       by metis
     have "fdisjnt (fmdom env\<^sub>0) (fmdom env\<^sub>1)"
       using match_dom
       using \<open>match pat _ = _\<close> \<open>match (name $$ pats) _ = _\<close>
       using \<open>fdisjnt _ _\<close>
       unfolding fdisjnt_alt_def
       by (metis matchs_dom match_list_combE)
     have "subst rhs env\<^sub>1 = t'"
       unfolding \<open>_ = rhs\<close>[symmetric]
       unfolding \<open>_ = t'\<close>[symmetric]
       unfolding \<open>env' = _\<close>
       unfolding \<open>env\<^sub>0 ++\<^sub>f _ = _\<close>
       apply (subst subst_indep')
       using \<open>closed_env env\<^sub>0\<close>
         apply blast
       using \<open>fdisjnt (fmdom _) _\<close>
       unfolding fdisjnt_alt_def
       by auto
 
     show ?thesis
       unfolding \<open>t = _\<close>
       apply rule
        apply (rule r_into_rtranclp)
        apply (rule irewrite.intros(3))
        apply rule
          apply fact+
        apply (rule irewrite_stepI)
         apply fact+
       unfolding \<open>t\<^sub>0' = _\<close>
       apply rule
        apply fact
       using \<open>match pat t\<^sub>1 = _\<close> \<open>subst rhs _ = _\<close>
       by force
   qed
 qed (auto intro: irewrite.rt_comb[unfolded app_pterm_def] intro!: irewrite.intros simp: closed_except_def)
 
 
 subsubsection \<open>Computability\<close>
 
 export_code
   compile transform_irules
   checking Scala SML
 
 end
\ No newline at end of file
diff --git a/thys/Coinductive_Languages/Context_Free_Grammar.thy b/thys/Coinductive_Languages/Context_Free_Grammar.thy
--- a/thys/Coinductive_Languages/Context_Free_Grammar.thy
+++ b/thys/Coinductive_Languages/Context_Free_Grammar.thy
@@ -1,177 +1,177 @@
 section \<open>Word Problem for Context-Free Grammars\<close>
 (*<*)
 theory Context_Free_Grammar
 imports Coinductive_Language "HOL-Library.FSet"
 begin
 (*>*)
 
 
 section \<open>Context Free Languages\<close>
 
 text \<open>
 A context-free grammar consists of a list of productions for every nonterminal
 and an initial nonterminal. The productions are required to be in weak Greibach
 normal form, i.e. each right hand side of a production must either be empty or
 start with a terminal.
 \<close>
 
 abbreviation "wgreibach \<alpha> \<equiv> (case \<alpha> of (Inr N # _) \<Rightarrow> False | _ \<Rightarrow> True)"
 
 record ('t, 'n) cfg =
   init :: "'n :: finite"
   prod :: "'n \<Rightarrow> ('t + 'n) list fset"
 
 context
   fixes G :: "('t, 'n :: finite) cfg"
 begin
 
 inductive in_cfl where
   "in_cfl [] []"
 | "in_cfl \<alpha> w \<Longrightarrow> in_cfl (Inl a # \<alpha>) (a # w)"
 | "fBex (prod G N) (\<lambda>\<beta>. in_cfl (\<beta> @ \<alpha>) w) \<Longrightarrow> in_cfl (Inr N # \<alpha>) w"
 
 abbreviation lang_trad where
   "lang_trad \<equiv> {w. in_cfl [Inr (init G)] w}"
 
 fun \<oo>\<^sub>P where
   "\<oo>\<^sub>P [] = True"
 | "\<oo>\<^sub>P (Inl _ # _) = False"
 | "\<oo>\<^sub>P (Inr N # \<alpha>) = ([] |\<in>| prod G N \<and> \<oo>\<^sub>P \<alpha>)"
 
 fun \<dd>\<^sub>P where
   "\<dd>\<^sub>P [] a = {||}"
 | "\<dd>\<^sub>P (Inl b # \<alpha>) a = (if a = b then {|\<alpha>|} else {||})"
 | "\<dd>\<^sub>P (Inr N # \<alpha>) a =
     (\<lambda>\<beta>. tl \<beta> @ \<alpha>) |`| ffilter (\<lambda>\<beta>. \<beta> \<noteq> [] \<and> hd \<beta> = Inl a) (prod G N) |\<union>|
     (if [] |\<in>| prod G N then \<dd>\<^sub>P \<alpha> a else {||})"
 
 primcorec subst :: "('t + 'n) list fset \<Rightarrow> 't language" where
   "subst P = Lang (fBex P \<oo>\<^sub>P) (\<lambda>a. subst (ffUnion ((\<lambda>r. \<dd>\<^sub>P r a) |`| P)))"
 
 inductive in_cfls where
   "fBex P \<oo>\<^sub>P \<Longrightarrow> in_cfls P []"
 | "in_cfls (ffUnion ((\<lambda>\<alpha>. \<dd>\<^sub>P \<alpha> a) |`| P)) w \<Longrightarrow> in_cfls P (a # w)"
 
 inductive_cases [elim!]: "in_cfls P []"
 inductive_cases [elim!]: "in_cfls P (a # w)"
 
 declare inj_eq[OF bij_is_inj[OF to_language_bij], simp]
 
 lemma subst_in_cfls: "subst P = to_language {w. in_cfls P w}"
   by (coinduction arbitrary: P) (auto intro: in_cfls.intros)
 
 lemma \<oo>\<^sub>P_in_cfl: "\<oo>\<^sub>P \<alpha> \<Longrightarrow> in_cfl \<alpha> []"
   by (induct \<alpha> rule: \<oo>\<^sub>P.induct) (auto intro!: in_cfl.intros elim: fBexI[rotated])
 
 lemma \<dd>\<^sub>P_in_cfl: "\<beta> |\<in>| \<dd>\<^sub>P \<alpha> a \<Longrightarrow> in_cfl \<beta> w \<Longrightarrow> in_cfl \<alpha> (a # w)"
 proof (induct \<alpha> a arbitrary: \<beta> w rule: \<dd>\<^sub>P.induct)
   case (3 N \<alpha> a)
   then show ?case
     by (auto simp: rev_fBexI neq_Nil_conv split: if_splits
       intro!: in_cfl.intros  elim!: rev_fBexI[of "_ # _"])
 qed (auto split: if_splits intro: in_cfl.intros)
 
 lemma in_cfls_in_cfl: "in_cfls P w \<Longrightarrow> fBex P (\<lambda>\<alpha>. in_cfl \<alpha> w)"
   by (induct P w rule: in_cfls.induct)
-    (auto simp: \<oo>\<^sub>P_in_cfl \<dd>\<^sub>P_in_cfl ffUnion.rep_eq fBex.rep_eq fBall.rep_eq
+    (auto simp: \<oo>\<^sub>P_in_cfl \<dd>\<^sub>P_in_cfl ffUnion.rep_eq
       intro: in_cfl.intros elim: rev_bexI)
 
 lemma in_cfls_mono: "in_cfls P w \<Longrightarrow> P |\<subseteq>| Q \<Longrightarrow> in_cfls Q w"
 proof (induct P w arbitrary: Q rule: in_cfls.induct)
   case (2 a P w)
   from 2(3) 2(2)[of "ffUnion ((\<lambda>\<alpha>. local.\<dd>\<^sub>P \<alpha> a) |`| Q)"] show ?case
     by (auto intro!: ffunion_mono in_cfls.intros)
 qed (auto intro!: in_cfls.intros)
 
 end
 
 locale cfg_wgreibach =
   fixes G :: "('t, 'n :: finite) cfg"
   assumes weakGreibach: "\<And>N \<alpha>. \<alpha> |\<in>| prod G N \<Longrightarrow> wgreibach \<alpha>"
 begin
 
 lemma in_cfl_in_cfls: "in_cfl G \<alpha> w \<Longrightarrow> in_cfls G {|\<alpha>|} w"
 proof (induct \<alpha> w rule: in_cfl.induct)
   case (3 N \<alpha> w)
   then obtain \<beta> where
     \<beta>: "\<beta> |\<in>| prod G N" and
     in_cfl: "in_cfl G (\<beta> @ \<alpha>) w" and
     in_cfls: "in_cfls G {|\<beta> @ \<alpha>|} w" by blast
   then show ?case
   proof (cases \<beta>)
     case [simp]: Nil
     from \<beta> in_cfls show ?thesis
        by (cases w) (auto intro!: in_cfls.intros elim: in_cfls_mono)
   next
     case [simp]: (Cons x \<gamma>)
     from weakGreibach[OF \<beta>] obtain a where [simp]: "x = Inl a" by (cases x) auto
     with \<beta> in_cfls show ?thesis
       apply -
       apply (rule  in_cfl.cases[OF in_cfl]; auto)
       apply (force intro: in_cfls.intros(2) elim!: in_cfls_mono)
       done
   qed
 qed (auto intro!: in_cfls.intros)
 
 abbreviation lang where
   "lang \<equiv> subst G {|[Inr (init G)]|}"
 
 lemma lang_lang_trad: "lang = to_language (lang_trad G)"
 proof -
   have "in_cfls G {|[Inr (init G)]|} w \<longleftrightarrow> in_cfl G [Inr (init G)] w" for w
     by (auto dest: in_cfls_in_cfl in_cfl_in_cfls)
   then show ?thesis
     by (auto simp: subst_in_cfls)
 qed
 
 end
 
 text \<open>
 The function @{term in_language} decides the word problem for a given language.
 Since we can construct the language of a CFG using @{const cfg_wgreibach.lang} we obtain an
 executable (but not very efficient) decision procedure for CFGs for free.
 \<close>
 
 abbreviation "\<aa> \<equiv> Inl True"
 abbreviation "\<bb> \<equiv> Inl False"
 abbreviation "S \<equiv> Inr ()"
 
 interpretation palindromes: cfg_wgreibach "\<lparr>init = (), prod = \<lambda>_. {|[], [\<aa>], [\<bb>], [\<aa>, S, \<aa>], [\<bb>, S, \<bb>]|}\<rparr>"
   by unfold_locales auto
 
 lemma "in_language palindromes.lang []" by normalization
 lemma "in_language palindromes.lang [True]" by normalization
 lemma "in_language palindromes.lang [False]" by normalization
 lemma "in_language palindromes.lang [True, True]" by normalization
 lemma "in_language palindromes.lang [True, False, True]" by normalization
 lemma "\<not> in_language palindromes.lang [True, False]" by normalization
 lemma "\<not> in_language palindromes.lang [True, False, True, False]" by normalization
 lemma "in_language palindromes.lang [True, False, True, True, False, True]" by normalization
 lemma "\<not> in_language palindromes.lang [True, False, True, False, False, True]" by normalization
 
 interpretation Dyck: cfg_wgreibach "\<lparr>init = (), prod = \<lambda>_. {|[], [\<aa>, S, \<bb>, S]|}\<rparr>"
   by unfold_locales auto
 lemma "in_language Dyck.lang []" by normalization
 lemma "\<not> in_language Dyck.lang [True]" by normalization
 lemma "\<not> in_language Dyck.lang [False]" by normalization
 lemma "in_language Dyck.lang [True, False, True, False]" by normalization
 lemma "in_language Dyck.lang [True, True, False, False]" by normalization
 lemma "in_language Dyck.lang [True, False, True, False]" by normalization
 lemma "in_language Dyck.lang [True, False, True, False, True, True, False, False]" by normalization
 lemma "\<not> in_language Dyck.lang [True, False, True, True, False]" by normalization
 lemma "\<not> in_language Dyck.lang [True, True, False, False, False, True]" by normalization
 
 interpretation abSSa: cfg_wgreibach "\<lparr>init = (), prod = \<lambda>_. {|[], [\<aa>, \<bb>, S, S, \<aa>]|}\<rparr>"
   by unfold_locales auto
 lemma "in_language abSSa.lang []" by normalization
 lemma "\<not> in_language abSSa.lang [True]" by normalization
 lemma "\<not> in_language abSSa.lang [False]" by normalization
 lemma "in_language abSSa.lang [True, False, True]" by normalization
 lemma "in_language abSSa.lang [True, False, True, False, True, True, False, True, True]" by normalization
 lemma "in_language abSSa.lang [True, False, True, False, True, True]" by normalization
 lemma "\<not> in_language abSSa.lang [True, False, True, True, False]" by normalization
 lemma "\<not> in_language abSSa.lang [True, True, False, False, False, True]" by normalization
 
 (*<*)
 end
 (*>*)
\ No newline at end of file
diff --git a/thys/Extended_Finite_State_Machine_Inference/Inference.thy b/thys/Extended_Finite_State_Machine_Inference/Inference.thy
--- a/thys/Extended_Finite_State_Machine_Inference/Inference.thy
+++ b/thys/Extended_Finite_State_Machine_Inference/Inference.thy
@@ -1,586 +1,586 @@
 chapter\<open>EFSM Inference\<close>
 text\<open>This chapter presents the definitions necessary for EFSM inference by state-merging.\<close>
 
 section\<open>Inference by State-Merging\<close>
 text\<open>This theory sets out the key definitions for the inference of EFSMs from system traces.\<close>
 
 theory Inference
   imports
     Subsumption
     "Extended_Finite_State_Machines.Transition_Lexorder"
     "HOL-Library.Product_Lexorder"
 begin
 
 declare One_nat_def [simp del]
 
 subsection\<open>Transition Identifiers\<close>
 
 text\<open>We first need to define the \texttt{iEFSM} data type which assigns each transition a unique identity.
 This is necessary because transitions may not occur uniquely in an EFSM. Assigning transitions a unique
 identifier enables us to look up the origin and destination states of transitions without having to
 pass them around in the inference functions.\<close>
 
 type_synonym tid = nat
 type_synonym tids = "tid list"
 type_synonym iEFSM = "(tids \<times> (cfstate \<times> cfstate) \<times> transition) fset"
 
 definition origin :: "tids \<Rightarrow> iEFSM \<Rightarrow> nat" where
   "origin uid t = fst (fst (snd (fthe_elem (ffilter (\<lambda>x. set uid \<subseteq> set (fst x)) t))))"
 
 definition dest :: "tids \<Rightarrow> iEFSM \<Rightarrow> nat" where
   "dest uid t = snd (fst (snd (fthe_elem (ffilter (\<lambda>x. set uid \<subseteq> set (fst x)) t))))"
 
 definition get_by_id :: "iEFSM \<Rightarrow> tid \<Rightarrow> transition" where
   "get_by_id e uid = (snd \<circ> snd) (fthe_elem (ffilter (\<lambda>(tids, _). uid \<in> set tids) e))"
 
 definition get_by_ids :: "iEFSM \<Rightarrow> tids \<Rightarrow> transition" where
   "get_by_ids e uid = (snd \<circ> snd) (fthe_elem (ffilter (\<lambda>(tids, _). set uid \<subseteq> set tids) e))"
 
 definition uids :: "iEFSM \<Rightarrow> nat fset" where
   "uids e = ffUnion (fimage (fset_of_list \<circ> fst) e)"
 
 definition max_uid :: "iEFSM \<Rightarrow> nat option" where
   "max_uid e = (let uids = uids e in if uids = {||} then None else Some (fMax uids))"
 
 definition tm :: "iEFSM \<Rightarrow> transition_matrix" where
   "tm e = fimage snd e"
 
 definition all_regs :: "iEFSM \<Rightarrow> nat set" where
   "all_regs e = EFSM.all_regs (tm e)"
 
 definition max_reg :: "iEFSM \<Rightarrow> nat option" where
   "max_reg e = EFSM.max_reg (tm e)"
 
 definition "max_reg_total e = (case max_reg e of None \<Rightarrow> 0 | Some r \<Rightarrow> r)"
 
 definition max_output :: "iEFSM \<Rightarrow> nat" where
   "max_output e = EFSM.max_output (tm e)"
 
 definition max_int :: "iEFSM \<Rightarrow> int" where
   "max_int e = EFSM.max_int (tm e)"
 
 definition S :: "iEFSM \<Rightarrow> nat fset" where
   "S m = (fimage (\<lambda>(uid, (s, s'), t). s) m) |\<union>| fimage (\<lambda>(uid, (s, s'), t). s') m"
 
 lemma S_alt: "S t = EFSM.S (tm t)"
   apply (simp add: S_def EFSM.S_def tm_def)
   by force
 
 lemma to_in_S:
   "(\<exists>to from uid. (uid, (from, to), t) |\<in>| xb \<longrightarrow> to |\<in>| S xb)"
   apply (simp add: S_def)
   by blast
 
 lemma from_in_S:
   "(\<exists>to from uid. (uid, (from, to), t) |\<in>| xb \<longrightarrow> from |\<in>| S xb)"
   apply (simp add: S_def)
   by blast
 
 subsection\<open>Building the PTA\<close>
 text\<open>The first step in EFSM inference is to construct a PTA from the observed traces in the same way
 as for classical FSM inference. Beginning with the empty EFSM, we iteratively attempt to walk each
 observed trace in the model. When we reach a point where there is no available transition, one is
 added. For classical FSMs, this is simply an atomic label. EFSMs deal with data, so we need to add
 guards which test for the observed input values and outputs which produce the observed values.\<close>
 
 primrec make_guard :: "value list \<Rightarrow> nat \<Rightarrow> vname gexp list" where
 "make_guard [] _ = []" |
 "make_guard (h#t) n = (gexp.Eq (V (vname.I n)) (L h))#(make_guard t (n+1))"
 
 primrec make_outputs :: "value list \<Rightarrow> output_function list" where
   "make_outputs [] = []" |
   "make_outputs (h#t) = (L h)#(make_outputs t)"
 
 definition max_uid_total :: "iEFSM \<Rightarrow> nat" where
   "max_uid_total e = (case max_uid e of None \<Rightarrow> 0 | Some u \<Rightarrow> u)"
 
 definition add_transition :: "iEFSM \<Rightarrow> cfstate \<Rightarrow> label \<Rightarrow> value list \<Rightarrow> value list \<Rightarrow> iEFSM" where
   "add_transition e s label inputs outputs = finsert ([max_uid_total e + 1], (s, (maxS (tm e))+1), \<lparr>Label=label, Arity=length inputs, Guards=(make_guard inputs 0), Outputs=(make_outputs outputs), Updates=[]\<rparr>) e"
 
 fun make_branch :: "iEFSM \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> trace \<Rightarrow> iEFSM" where
   "make_branch e _ _ [] = e" |
   "make_branch e s r ((label, inputs, outputs)#t) =
     (case (step (tm e) s r label inputs) of
       Some (transition, s', outputs', updated) \<Rightarrow>
         if outputs' = (map Some outputs) then
           make_branch e s' updated t
         else
           make_branch (add_transition e s label inputs outputs) ((maxS (tm e))+1) r t  |
       None \<Rightarrow>
           make_branch (add_transition e s label inputs outputs) ((maxS (tm e))+1) r t
     )"
 
 primrec make_pta_aux :: "log \<Rightarrow> iEFSM \<Rightarrow> iEFSM" where
   "make_pta_aux [] e = e" |
   "make_pta_aux (h#t) e = make_pta_aux t (make_branch e 0 <> h)"
 
 definition "make_pta log = make_pta_aux log {||}"
 
 lemma make_pta_aux_fold [code]:
   "make_pta_aux l e = fold (\<lambda>h e. make_branch e 0 <> h) l e"
   by(induct l arbitrary: e, auto)
 
 subsection\<open>Integrating Heuristics\<close>
 text\<open>A key contribution of the inference technique presented in \<^cite>\<open>"foster2019"\<close> is the ability to
 introduce \emph{internal variables} to the model to generalise behaviours and allow transitions to
 be merged. This is done by providing the inference technique with a set of \emph{heuristics}. The
 aim here is not to create a ``one size fits all'' magic oracle, rather to recognise particular
 \emph{data usage patterns} which can be abstracted.\<close>
 
 type_synonym update_modifier = "tids \<Rightarrow> tids \<Rightarrow> cfstate \<Rightarrow> iEFSM \<Rightarrow> iEFSM \<Rightarrow> iEFSM \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> iEFSM option"
 
 definition null_modifier :: update_modifier where
   "null_modifier f _ _ _ _ _ _ = None"
 
 definition replace_transition :: "iEFSM \<Rightarrow> tids \<Rightarrow> transition \<Rightarrow> iEFSM" where
   "replace_transition e uid new = (fimage (\<lambda>(uids, (from, to), t). if set uid \<subseteq> set uids then (uids, (from, to), new) else (uids, (from, to), t)) e)"
 
 definition replace_all :: "iEFSM \<Rightarrow> tids list \<Rightarrow> transition \<Rightarrow> iEFSM" where
   "replace_all e ids new = fold (\<lambda>id acc. replace_transition acc id new) ids e"
 
 definition replace_transitions :: "iEFSM \<Rightarrow> (tids \<times> transition) list \<Rightarrow> iEFSM" where
   "replace_transitions e ts = fold (\<lambda>(uid, new) acc. replace_transition acc uid new) ts e"
 
 primrec try_heuristics_check :: "(transition_matrix \<Rightarrow> bool) \<Rightarrow> update_modifier list \<Rightarrow> update_modifier" where
   "try_heuristics_check _ [] = null_modifier" |
   "try_heuristics_check check (h#t) = (\<lambda>a b c d e f ch.
     case h a b c d e f ch of
       Some e' \<Rightarrow> Some e' |
       None \<Rightarrow> (try_heuristics_check check t) a b c d e f ch
     )"
 
 subsection\<open>Scoring State Merges\<close>
 text\<open>To tackle the state merging challenge, we need some means of determining which states are
 compatible for merging. Because states are merged pairwise, we additionally require a way of
 ordering the state merges. The potential merges are then sorted highest to lowest according to this
 score such that we can merge states in order of their merge score.
 
 We want to sort first by score (highest to lowest) and then by state pairs (lowest to highest) so we
 endup merging the states with the highest scores first and then break ties by those state pairs
 which are closest to the origin.\<close>
 
 record score =
   Score :: nat
   S1 :: cfstate
   S2 :: cfstate
 
 instantiation score_ext :: (linorder) linorder begin
 definition less_score_ext :: "'a::linorder score_ext \<Rightarrow> 'a score_ext \<Rightarrow> bool" where
 "less_score_ext t1 t2 = ((Score t2, S1 t1, S2 t1, more t1) < (Score t1, S1 t2, S2 t2, more t2) )"
 
 definition less_eq_score_ext :: "'a::linorder score_ext \<Rightarrow> 'a::linorder score_ext \<Rightarrow> bool" where
  "less_eq_score_ext s1 s2 = (s1 < s2 \<or> s1 = s2)"
 
 instance
   apply standard prefer 5
   unfolding less_score_ext_def less_eq_score_ext_def
   using score.equality apply fastforce
   by auto
 end
 
 type_synonym scoreboard = "score fset"
 type_synonym strategy = "tids \<Rightarrow> tids \<Rightarrow> iEFSM \<Rightarrow> nat"
 
 definition outgoing_transitions :: "cfstate \<Rightarrow> iEFSM \<Rightarrow> (cfstate \<times> transition \<times> tids) fset" where
   "outgoing_transitions s e = fimage (\<lambda>(uid, (from, to), t'). (to, t', uid)) ((ffilter (\<lambda>(uid, (origin, dest), t). origin = s)) e)"
 
 primrec paths_of_length :: "nat \<Rightarrow> iEFSM \<Rightarrow> cfstate \<Rightarrow> tids list fset" where
   "paths_of_length 0 _ _ = {|[]|}" |
   "paths_of_length (Suc m) e s = (
     let
       outgoing = outgoing_transitions s e;
       paths = ffUnion (fimage (\<lambda>(d, t, id). fimage (\<lambda>p. id#p) (paths_of_length m e d)) outgoing)
     in
       ffilter (\<lambda>l. length l = Suc m) paths
   )"
 
 lemma paths_of_length_1: "paths_of_length 1 e s = fimage (\<lambda>(d, t, id). [id]) (outgoing_transitions s e)"
   apply (simp add: One_nat_def)
   apply (simp add: outgoing_transitions_def comp_def One_nat_def[symmetric])
   apply (rule fBall_ffilter2)
    defer
-   apply (simp add: ffilter_def ffUnion_def fBall_def Abs_fset_inverse)
+   apply (simp add: ffilter_def ffUnion_def Abs_fset_inverse)
    apply auto[1]
-  apply (simp add: ffilter_def ffUnion_def fBall_def Abs_fset_inverse fset_both_sides)
+  apply (simp add: ffilter_def ffUnion_def Abs_fset_inverse fset_both_sides)
   by force
 
 fun step_score :: "(tids \<times> tids) list \<Rightarrow> iEFSM \<Rightarrow> strategy \<Rightarrow> nat" where
   "step_score [] _ _ = 0" |
   "step_score ((id1, id2)#t) e s = (
     let score = s id1 id2 e in
     if score = 0 then
       0
     else
       score + (step_score t e s)
   )"
 
 lemma step_score_foldr [code]:
   "step_score xs e s = foldr (\<lambda>(id1, id2) acc. let score = s id1 id2 e in
     if score = 0 then
       0
     else
       score + acc) xs 0"
 proof(induct xs)
 case Nil
   then show ?case
     by simp
 next
   case (Cons a xs)
   then show ?case
     apply (cases a, clarify)
     by (simp add: Let_def)
 qed
 
 definition score_from_list :: "tids list fset \<Rightarrow> tids list fset \<Rightarrow> iEFSM \<Rightarrow> strategy \<Rightarrow> nat" where
   "score_from_list P1 P2 e s = (
     let
       pairs = fimage (\<lambda>(l1, l2). zip l1 l2) (P1 |\<times>| P2);
       scored_pairs = fimage (\<lambda>l. step_score l e s) pairs
     in
     fSum scored_pairs
   )"
 
 definition k_score :: "nat \<Rightarrow> iEFSM \<Rightarrow> strategy \<Rightarrow> scoreboard" where
   "k_score k e strat = (
     let
       states = S e;
       pairs_to_score = (ffilter (\<lambda>(x, y). x < y) (states |\<times>| states));
       paths = fimage (\<lambda>(s1, s2). (s1, s2, paths_of_length k e s1, paths_of_length k e s2)) pairs_to_score;
       scores = fimage (\<lambda>(s1, s2, p1, p2). \<lparr>Score = score_from_list p1 p2 e strat, S1 = s1, S2 = s2\<rparr>) paths
     in
     ffilter (\<lambda>x. Score x > 0) scores
 )"
 
 definition score_state_pair :: "strategy \<Rightarrow> iEFSM \<Rightarrow> cfstate \<Rightarrow> cfstate \<Rightarrow> nat" where
   "score_state_pair strat e s1 s2 = (
     let
       T1 = outgoing_transitions s1 e;
       T2 = outgoing_transitions s2 e
     in
       fSum (fimage (\<lambda>((_, _, t1), (_, _, t2)). strat t1 t2 e) (T1 |\<times>| T2))
   )"
 
 definition score_1 :: "iEFSM \<Rightarrow> strategy \<Rightarrow> scoreboard" where
   "score_1 e strat = (
     let
       states = S e;
       pairs_to_score = (ffilter (\<lambda>(x, y). x < y) (states |\<times>| states));
       scores = fimage (\<lambda>(s1, s2). \<lparr>Score = score_state_pair strat e s1 s2, S1 = s1, S2 = s2\<rparr>) pairs_to_score
     in
       ffilter (\<lambda>x. Score x > 0) scores
   )"
 
 lemma score_1: "score_1 e s = k_score 1 e s"
 proof-
   have fprod_fimage:
     "\<And>a b. ((\<lambda>(_, _, id). [id]) |`| a |\<times>| (\<lambda>(_, _, id). [id]) |`| b) =
        fimage (\<lambda>((_, _, id1), (_, _, id2)). ([id1], [id2])) (a |\<times>| b)"
     apply (simp add: fimage_def fprod_def Abs_fset_inverse fset_both_sides)
     by force
   show ?thesis
     apply (simp add: score_1_def k_score_def Let_def comp_def)
     apply (rule arg_cong[of _ _ "ffilter (\<lambda>x. 0 < Score x)"])
     apply (rule fun_cong[of _ _ "(Inference.S e |\<times>| Inference.S e)"])
     apply (rule ext)
     subgoal for x
       apply (rule fun_cong[of _ _ "ffilter (\<lambda>a. case a of (a, b) \<Rightarrow> a < b) x"])
       apply (rule arg_cong[of _ _ fimage])
       apply (rule ext)
       subgoal for x
         apply (case_tac x)
         apply simp
         apply (simp add: paths_of_length_1)
         apply (simp add: score_state_pair_def Let_def score_from_list_def comp_def)
         subgoal for a b
           apply (rule arg_cong[of _ _ fSum])
           apply (simp add: fprod_fimage)
           apply (rule fun_cong[of _ _ "(outgoing_transitions a e |\<times>| outgoing_transitions b e)"])
           apply (rule arg_cong[of _ _ fimage])
           apply (rule ext)
           apply clarify
           by (simp add: Let_def)
         done
       done
     done
 qed
 
 fun bool2nat :: "bool \<Rightarrow> nat" where
   "bool2nat True = 1" |
   "bool2nat False = 0"
 
 definition score_transitions :: "transition \<Rightarrow> transition \<Rightarrow> nat" where
   "score_transitions t1 t2 = (
     if Label t1 = Label t2 \<and> Arity t1 = Arity t2 \<and> length (Outputs t1) = length (Outputs t2) then
       1 + bool2nat (t1 = t2) + card ((set (Guards t2)) \<inter> (set (Guards t2))) + card ((set (Updates t2)) \<inter> (set (Updates t2))) + card ((set (Outputs t2)) \<inter> (set (Outputs t2)))
     else
       0
   )"
 
 subsection\<open>Merging States\<close>
 definition merge_states_aux :: "nat \<Rightarrow> nat \<Rightarrow> iEFSM \<Rightarrow> iEFSM" where
   "merge_states_aux s1 s2 e = fimage (\<lambda>(uid, (origin, dest), t). (uid, (if origin = s1 then s2 else origin , if dest = s1 then s2 else dest), t)) e"
 
 definition merge_states :: "nat \<Rightarrow> nat \<Rightarrow> iEFSM \<Rightarrow> iEFSM" where
   "merge_states x y t = (if x > y then merge_states_aux x y t else merge_states_aux y x t)"
 
 lemma merge_states_symmetry: "merge_states x y t = merge_states y x t"
   by (simp add: merge_states_def)
 
 lemma merge_state_self: "merge_states s s t = t"
   apply (simp add: merge_states_def merge_states_aux_def)
   by force
 
 lemma merge_states_self_simp [code]:
   "merge_states x y t = (if x = y then t else if x > y then merge_states_aux x y t else merge_states_aux y x t)"
   apply (simp add: merge_states_def merge_states_aux_def)
   by force
 
 subsection\<open>Resolving Nondeterminism\<close>
 text\<open>Because EFSM transitions are not simply atomic actions, duplicated behaviours cannot be
 resolved into a single transition by simply merging destination states, as it can in classical FSM
 inference. It is now possible for attempts to resolve the nondeterminism introduced by merging
 states to fail, meaning that two states which initially seemed compatible cannot actually be merged.
 This is not the case in classical FSM inference.\<close>
 
 type_synonym nondeterministic_pair = "(cfstate \<times> (cfstate \<times> cfstate) \<times> ((transition \<times> tids) \<times> (transition \<times> tids)))"
 
 definition state_nondeterminism :: "nat \<Rightarrow> (cfstate \<times> transition \<times> tids) fset \<Rightarrow> nondeterministic_pair fset" where
   "state_nondeterminism og nt = (if size nt < 2 then {||} else ffUnion (fimage (\<lambda>x. let (dest, t) = x in fimage (\<lambda>y. let (dest', t') = y in (og, (dest, dest'), (t, t'))) (nt - {|x|})) nt))"
 
 lemma state_nondeterminism_empty [simp]: "state_nondeterminism a {||} = {||}"
   by (simp add: state_nondeterminism_def ffilter_def Set.filter_def)
 
 lemma state_nondeterminism_singledestn [simp]: "state_nondeterminism a {|x|} = {||}"
   by (simp add: state_nondeterminism_def ffilter_def Set.filter_def)
 
 (* For each state, get its outgoing transitions and see if there's any nondeterminism there *)
 definition nondeterministic_pairs :: "iEFSM \<Rightarrow> nondeterministic_pair fset" where
   "nondeterministic_pairs t = ffilter (\<lambda>(_, _, (t, _), (t', _)). Label t = Label t' \<and> Arity t = Arity t' \<and> choice t t') (ffUnion (fimage (\<lambda>s. state_nondeterminism s (outgoing_transitions s t)) (S t)))"
 
 definition nondeterministic_pairs_labar_dest :: "iEFSM \<Rightarrow> nondeterministic_pair fset" where
   "nondeterministic_pairs_labar_dest t = ffilter
      (\<lambda>(_, (d, d'), (t, _), (t', _)).
       Label t = Label t' \<and> Arity t = Arity t' \<and> (choice t t' \<or> (Outputs t = Outputs t' \<and> d = d')))
      (ffUnion (fimage (\<lambda>s. state_nondeterminism s (outgoing_transitions s t)) (S t)))"
 
 definition nondeterministic_pairs_labar :: "iEFSM \<Rightarrow> nondeterministic_pair fset" where
   "nondeterministic_pairs_labar t = ffilter
      (\<lambda>(_, (d, d'), (t, _), (t', _)).
       Label t = Label t' \<and> Arity t = Arity t' \<and> (choice t t' \<or> Outputs t = Outputs t'))
      (ffUnion (fimage (\<lambda>s. state_nondeterminism s (outgoing_transitions s t)) (S t)))"
 
 definition deterministic :: "iEFSM \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> bool" where
   "deterministic t np = (np t = {||})"
 
 definition nondeterministic :: "iEFSM \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> bool" where
   "nondeterministic t np = (\<not> deterministic t np)"
 
 definition insert_transition :: "tids \<Rightarrow> cfstate \<Rightarrow> cfstate \<Rightarrow> transition \<Rightarrow> iEFSM \<Rightarrow> iEFSM" where
   "insert_transition uid from to t e = (
     if \<nexists>(uid, (from', to'), t') |\<in>| e. from = from' \<and> to = to' \<and> t = t' then
       finsert (uid, (from, to), t) e
     else
       fimage (\<lambda>(uid', (from', to'), t').
         if from = from' \<and> to = to' \<and> t = t' then
           (List.union uid' uid, (from', to'), t')
         else
           (uid', (from', to'), t')
       ) e
   )"
 
 definition make_distinct :: "iEFSM \<Rightarrow> iEFSM" where
   "make_distinct e = ffold_ord (\<lambda>(uid, (from, to), t) acc. insert_transition uid from to t acc) e {||}"
 
 \<comment> \<open>When we replace one transition with another, we need to merge their uids to keep track of which\<close>
 \<comment> \<open>transition accounts for which action in the original traces                                     \<close>
 definition merge_transitions_aux :: "iEFSM \<Rightarrow> tids \<Rightarrow> tids \<Rightarrow> iEFSM" where
   "merge_transitions_aux e oldID newID = (let
     (uids1, (origin, dest), old) = fthe_elem (ffilter (\<lambda>(uids, _). oldID = uids) e);
     (uids2, (origin, dest), new) = fthe_elem (ffilter (\<lambda>(uids, _). newID = uids) e) in
     make_distinct (finsert (List.union uids1 uids2, (origin, dest), new) (e - {|(uids1, (origin, dest), old), (uids2, (origin, dest), new)|}))
   )"
 
 (* merge_transitions - Try dest merge transitions t1 and t2 dest help resolve nondeterminism in
                        newEFSM. If either subsumes the other directly then the subsumed transition
                        can simply be replaced with the subsuming one, else we try dest apply the
                        modifier function dest resolve nondeterminism that way.                    *)
 (* @param oldEFSM   - the EFSM before merging the states which caused the nondeterminism          *)
 (* @param preDestMerge   - the EFSM after merging the states which caused the nondeterminism      *)
 (* @param newEFSM   - the current EFSM with nondeterminism                                        *)
 (* @param t1        - a transition dest be merged with t2                                         *)
 (* @param u1        - the unique identifier of t1                                                 *)
 (* @param t2        - a transition dest be merged with t1                                         *)
 (* @param u2        - the unique identifier of t2                                                 *)
 (* @param modifier  - an update modifier function which tries dest generalise transitions         *)
 definition merge_transitions :: "(cfstate \<times> cfstate) set \<Rightarrow> iEFSM \<Rightarrow> iEFSM \<Rightarrow> iEFSM \<Rightarrow> transition \<Rightarrow> tids \<Rightarrow> transition \<Rightarrow> tids \<Rightarrow> update_modifier \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> iEFSM option" where
   "merge_transitions failedMerges oldEFSM preDestMerge destMerge t1 u1 t2 u2 modifier check = (
      if \<forall>id \<in> set u1. directly_subsumes (tm oldEFSM) (tm destMerge) (origin [id] oldEFSM) (origin u1 destMerge) t2 t1 then
        \<comment> \<open>Replace t1 with t2\<close>
        Some (merge_transitions_aux destMerge u1 u2)
      else if \<forall>id \<in> set u2. directly_subsumes (tm oldEFSM) (tm destMerge) (origin [id] oldEFSM) (origin u2 destMerge) t1 t2 then
        \<comment> \<open>Replace t2 with t1\<close>
        Some (merge_transitions_aux destMerge u2 u1)
      else
         case modifier u1 u2 (origin u1 destMerge) destMerge preDestMerge oldEFSM check of
           None \<Rightarrow> None |
           Some e \<Rightarrow> Some (make_distinct e)
    )"
 
 definition outgoing_transitions_from :: "iEFSM \<Rightarrow> cfstate \<Rightarrow> transition fset" where
   "outgoing_transitions_from e s = fimage (\<lambda>(_, _, t). t) (ffilter (\<lambda>(_, (orig, _), _). orig = s) e)"
 
 definition order_nondeterministic_pairs :: "nondeterministic_pair fset \<Rightarrow> nondeterministic_pair list" where
   "order_nondeterministic_pairs s = map snd (sorted_list_of_fset (fimage (\<lambda>s. let (_, _, (t1, _), (t2, _)) = s in (score_transitions t1 t2, s)) s))"
 
 (* resolve_nondeterminism - tries dest resolve nondeterminism in a given iEFSM                      *)
 (* @param ((from, (dest1, dest2), ((t1, u1), (t2, u2)))#ss) - a list of nondeterministic pairs where
           from - nat - the state from which t1 and t2 eminate
           dest1  - nat - the destination state of t1
           dest2  - nat - the destination state of t2
           t1   - transition - a transition dest be merged with t2
           t2   - transition - a transition dest be merged with t1
           u1   - nat - the unique identifier of t1
           u2   - nat - the unique identifier of t2
           ss   - list - the rest of the list                                                      *)
 (* @param oldEFSM - the EFSM before merging the states which caused the nondeterminism            *)
 (* @param newEFSM - the current EFSM with nondeterminism                                          *)
 (* @param m       - an update modifier function which tries dest generalise transitions             *)
 (* @param check - a function which takes an EFSM and returns a bool dest ensure that certain
                   properties hold in the new iEFSM                                                *)
 function resolve_nondeterminism :: "(cfstate \<times> cfstate) set \<Rightarrow> nondeterministic_pair list \<Rightarrow> iEFSM \<Rightarrow> iEFSM \<Rightarrow> update_modifier \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> (iEFSM option \<times> (cfstate \<times> cfstate) set)" where
   "resolve_nondeterminism failedMerges [] _ newEFSM _ check np = (
       if deterministic newEFSM np \<and> check (tm newEFSM) then Some newEFSM else None, failedMerges
   )" |
   "resolve_nondeterminism failedMerges ((from, (dest1, dest2), ((t1, u1), (t2, u2)))#ss) oldEFSM newEFSM m check np = (
     if (dest1, dest2) \<in> failedMerges \<or> (dest2, dest1) \<in> failedMerges then
       (None, failedMerges)
     else
     let destMerge = merge_states dest1 dest2 newEFSM in
     case merge_transitions failedMerges oldEFSM newEFSM destMerge t1 u1 t2 u2 m check of
       None \<Rightarrow> resolve_nondeterminism (insert (dest1, dest2) failedMerges) ss oldEFSM newEFSM m check np |
       Some new \<Rightarrow> (
         let newScores = order_nondeterministic_pairs (np new) in
         if (size new, size (S new), size (newScores)) < (size newEFSM, size (S newEFSM), size ss) then
           case resolve_nondeterminism failedMerges newScores oldEFSM new m check np of
             (Some new', failedMerges) \<Rightarrow> (Some new', failedMerges) |
             (None, failedMerges) \<Rightarrow> resolve_nondeterminism (insert (dest1, dest2) failedMerges) ss oldEFSM newEFSM m check np
         else
           (None, failedMerges)
       )
   )"
      apply (clarify, metis neq_Nil_conv prod_cases3 surj_pair)
   by auto
 termination
   by (relation "measures [\<lambda>(_, _, _, newEFSM, _). size newEFSM,
                           \<lambda>(_, _, _, newEFSM, _). size (S newEFSM),
                           \<lambda>(_, ss, _, _, _). size ss]", auto)
 
 subsection\<open>EFSM Inference\<close>
 
 (* Merge - tries dest merge two states in a given iEFSM and resolve the resulting nondeterminism  *)
 (* @param e     - an iEFSM                                                                        *)
 (* @param s1    - a state dest be merged with s2                                                  *)
 (* @param s2    - a state dest be merged with s1                                                  *)
 (* @param m     - an update modifier function which tries dest generalise transitions             *)
 (* @param check - a function which takes an EFSM and returns a bool dest ensure that certain
                   properties hold in the new iEFSM                                                *)
 definition merge :: "(cfstate \<times> cfstate) set \<Rightarrow> iEFSM \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> update_modifier \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> (iEFSM option \<times> (cfstate \<times> cfstate) set)" where
   "merge failedMerges e s1 s2 m check np = (
     if s1 = s2 \<or> (s1, s2) \<in> failedMerges \<or> (s2, s1) \<in> failedMerges then
       (None, failedMerges)
     else
       let e' = make_distinct (merge_states s1 s2 e) in
       resolve_nondeterminism failedMerges (order_nondeterministic_pairs (np e')) e e' m check np
   )"
 
 (* inference_step - attempt dest carry out a single step of the inference process by merging the  *)
 (* @param e - an iEFSM dest be generalised                                                        *)
 (* @param ((s, s1, s2)#t) - a list of triples of the form (score, state, state) dest be merged    *)
 (* @param m     - an update modifier function which tries dest generalise transitions             *)
 (* @param check - a function which takes an EFSM and returns a bool dest ensure that certain
                   properties hold in the new iEFSM                                                *)
 function inference_step :: "(cfstate \<times> cfstate) set \<Rightarrow> iEFSM \<Rightarrow> score fset \<Rightarrow> update_modifier \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> (iEFSM option \<times> (cfstate \<times> cfstate) set)" where
   "inference_step failedMerges e s m check np = (
      if s = {||} then (None, failedMerges) else
      let
       h = fMin s;
       t = s - {|h|}
     in
     case merge failedMerges e (S1 h) (S2 h) m check np of
       (Some new, failedMerges) \<Rightarrow> (Some new, failedMerges) |
       (None, failedMerges) \<Rightarrow> inference_step (insert ((S1 h), (S2 h)) failedMerges) e t m check np
   )"
   by auto
 termination
   by (relation "measures [\<lambda>(_, _, s, _, _, _). size s]") (auto dest!: card_minus_fMin)
 
 (* Takes an iEFSM and iterates inference_step until no further states can be successfully merged  *)
 (* @param e - an iEFSM dest be generalised                                                        *)
 (* @param r - a strategy dest identify and prioritise pairs of states dest merge                  *)
 (* @param m     - an update modifier function which tries dest generalise transitions             *)
 (* @param check - a function which takes an EFSM and returns a bool dest ensure that certain
                   properties hold in the new iEFSM                                                *)
 function infer :: "(cfstate \<times> cfstate) set \<Rightarrow> nat \<Rightarrow> iEFSM \<Rightarrow> strategy \<Rightarrow> update_modifier \<Rightarrow> (transition_matrix \<Rightarrow> bool) \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> iEFSM" where
   "infer failedMerges k e r m check np = (
     let scores = if k = 1 then score_1 e r else (k_score k e r) in
     case inference_step failedMerges e (ffilter (\<lambda>s. (S1 s, S2 s) \<notin> failedMerges \<and> (S2 s, S1 s) \<notin> failedMerges) scores) m check np of
       (None, _) \<Rightarrow> e |
       (Some new, failedMerges) \<Rightarrow> if (S new) |\<subset>| (S e) then infer failedMerges k new r m check np else e
   )"
   by auto
 termination
   apply (relation "measures [\<lambda>(_, _, e, _). size (S e)]")
    apply simp
   by (metis (no_types, lifting) case_prod_conv measures_less size_fsubset)
 
 fun get_ints :: "trace \<Rightarrow> int list" where
   "get_ints [] = []" |
   "get_ints ((_, inputs, outputs)#t) = (map (\<lambda>x. case x of Num n \<Rightarrow> n) (filter is_Num (inputs@outputs)))"
 
 definition learn :: "nat \<Rightarrow> iEFSM \<Rightarrow> log \<Rightarrow> strategy \<Rightarrow> update_modifier \<Rightarrow> (iEFSM \<Rightarrow> nondeterministic_pair fset) \<Rightarrow> iEFSM" where
   "learn n pta l r m np = (
      let check = accepts_log (set l) in
          (infer {} n pta r m check np)
    )"
 
 subsection\<open>Evaluating Inferred Models\<close>
 text\<open>We need a function to test the EFSMs we infer. The \texttt{test\_trace} function executes a
 trace in the model and outputs a more comprehensive trace such that the expected outputs and actual
 outputs can be compared. If a point is reached where the model does not recognise an action, the
 remainder of the trace forms the second element of the output pair such that we know the exact point
 at which the model stopped processing.\<close>
 
 definition i_possible_steps :: "iEFSM \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> label \<Rightarrow> inputs \<Rightarrow> (tids \<times> cfstate \<times> transition) fset" where
   "i_possible_steps e s r l i = fimage (\<lambda>(uid, (origin, dest), t). (uid, dest, t))
   (ffilter (\<lambda>(uid, (origin, dest::nat), t::transition).
       origin = s
       \<and> (Label t) = l
       \<and> (length i) = (Arity t)
       \<and> apply_guards (Guards t) (join_ir i r)
      )
     e)"
 
 fun test_trace :: "trace \<Rightarrow> iEFSM \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> ((label \<times> inputs \<times> cfstate \<times> cfstate \<times> registers \<times> tids \<times> value list \<times> outputs) list \<times> trace)" where
   "test_trace [] _ _ _ = ([], [])" |
   "test_trace ((l, i, expected)#es) e s r = (
     let
       ps = i_possible_steps e s r l i
     in
       if fis_singleton ps then
         let
           (id, s', t) = fthe_elem ps;
           r' = evaluate_updates t i r;
           actual = evaluate_outputs t i r;
           (est, fail) = (test_trace es e s' r')
         in
         ((l, i, s, s', r, id, expected, actual)#est, fail)
       else
         ([], (l, i, expected)#es)
   )"
 
 text\<open>The \texttt{test\_log} function executes the \texttt{test\_trace} function on a collection of
 traces known as the \emph{test set.}\<close>
 definition test_log :: "log \<Rightarrow> iEFSM \<Rightarrow> ((label \<times> inputs \<times> cfstate \<times> cfstate \<times> registers \<times> tids \<times> value list \<times> outputs) list \<times> trace) list" where
   "test_log l e = map (\<lambda>t. test_trace t e 0 <>) l"
 
 end
diff --git a/thys/Extended_Finite_State_Machine_Inference/code-targets/Code_Target_FSet.thy b/thys/Extended_Finite_State_Machine_Inference/code-targets/Code_Target_FSet.thy
--- a/thys/Extended_Finite_State_Machine_Inference/code-targets/Code_Target_FSet.thy
+++ b/thys/Extended_Finite_State_Machine_Inference/code-targets/Code_Target_FSet.thy
@@ -1,164 +1,155 @@
 section\<open>Finite Sets\<close>
 text\<open>Here we define the operations on the \texttt{fset} datatype in terms of lists rather than sets.
 This allows the Scala implementation to skip a case match each time, which makes for cleaner and
 slightly faster code.\<close>
 
 theory Code_Target_FSet
   imports "Extended_Finite_State_Machines.FSet_Utils"
 begin
 
 code_datatype fset_of_list
 
 declare FSet.fset_of_list.rep_eq [code]
 
 lemma fprod_code [code]:
   "fprod (fset_of_list xs) (fset_of_list ys) = fset_of_list (remdups [(x, y). x \<leftarrow> xs, y \<leftarrow> ys])"
   apply (simp add: fprod_def fset_of_list_def fset_both_sides Abs_fset_inverse)
   by auto
 
 lemma fminus_fset_filter [code]:
   "fset_of_list A -  xs = fset_of_list (remdups (filter (\<lambda>x. x |\<notin>| xs) A))"
   by auto
 
 lemma sup_fset_fold [code]:
   "(fset_of_list f1) |\<union>| (fset_of_list f2) = fset_of_list (remdups (f1@f2))"
   by simp
 
 lemma bot_fset [code]: "{||} = fset_of_list []"
   by simp
 
 lemma finsert [code]:
   "finsert a (fset_of_list as) = fset_of_list (List.insert a as)"
   by (simp add: List.insert_def finsert_absorb fset_of_list_elem)
 
 lemma ffilter_filter [code]:
   "ffilter f (fset_of_list as) = fset_of_list (List.filter f (remdups as))"
   by simp
 
 lemma fimage_map [code]:
   "fimage f (fset_of_list as) = fset_of_list (List.map f (remdups as))"
   by simp
 
 lemma ffUnion_fold [code]:
   "ffUnion (fset_of_list as) = fold (|\<union>|) as {||}"
   by (simp add: fold_union_ffUnion)
 
 lemma fmember [code]: "a |\<in>| (fset_of_list as) = List.member as a"
   by (simp add: fset_of_list_elem member_def)
 
 lemma fthe_elem [code]: "fthe_elem (fset_of_list [x]) = x"
   by simp
 
 lemma size [code]: "size (fset_of_list as) = length (remdups as)"
 proof(induct as)
   case Nil
   then show ?case
     by simp
 next
   case (Cons a as)
   then show ?case
     by (simp add: fset_of_list.rep_eq insert_absorb)
 qed
 
 lemma fMax_fold [code]: "fMax (fset_of_list (a#as)) = fold max as a"
   by (metis Max.set_eq_fold fMax.F.rep_eq fset_of_list.rep_eq)
 
 lemma fMin_fold [code]: "fMin (fset_of_list (h#t)) = fold min t h"
   apply (simp add: fset_of_list_def)
   by (metis Min.set_eq_fold fMin_Min fset_of_list.abs_eq list.simps(15))
 
 lemma fremove_code [code]:
   "fremove a (fset_of_list A) = fset_of_list (filter (\<lambda>x. x \<noteq> a) A)"
   apply (simp add: fremove_def minus_fset_def ffilter_def fset_both_sides Abs_fset_inverse fset_of_list.rep_eq)
   by auto
 
 lemma fsubseteq [code]:
   "(fset_of_list l) |\<subseteq>| A = List.list_all (\<lambda>x. x |\<in>| A) l"
   by (induct l, auto)
 
 lemma fsum_fold [code]: "fSum (fset_of_list l) = fold (+) (remdups l) 0"
 proof(induct l)
 case Nil
 then show ?case
   by (simp add: fsum.F.rep_eq fSum_def)
 next
   case (Cons a l)
   then show ?case
     apply simp
     apply standard
      apply (simp add: finsert_absorb fset_of_list_elem)
     by (simp add: add.commute fold_plus_sum_list_rev fset_of_list.rep_eq fsum.F.rep_eq fSum_def)
 qed
 
 lemma code_fset_eq [code]:
   "HOL.equal X (fset_of_list Y) \<longleftrightarrow> size X = length (remdups Y) \<and> (\<forall>x |\<in>| X. List.member Y x)"
   apply (simp only: HOL.equal_class.equal_eq fset_eq_alt)
   apply (simp only: size)
   using fmember by fastforce
 
 lemma code_fsubset [code]:
   "s |\<subset>| s' = (s |\<subseteq>| s' \<and> size s < size s')"
   apply standard
    apply (simp only: size_fsubset)
   by auto
 
-lemma code_fset [code]: "fset (fset_of_list l) = fold insert l {}"
-  using fset_of_list.rep_eq union_set_fold by fastforce
-
-lemma code_fBall [code]: "fBall (fset_of_list l) f = list_all f l"
-  by (simp add: Ball_set fBall.rep_eq fset_of_list.rep_eq)
-
-lemma code_fBex [code]: "fBex (fset_of_list l) f = list_ex f l"
-  by (meson Bex_set fBexE fset_of_list_elem rev_fBexI)
-
 definition "nativeSort = sort"
 code_printing constant nativeSort \<rightharpoonup> (Scala) "_.sortWith((Orderings.less))"
 
 lemma [code]: "sorted_list_of_fset (fset_of_list l) = nativeSort (remdups l)"
   by (simp add: nativeSort_def sorted_list_of_fset_sort)
 
 lemma [code]: "sorted_list_of_set (set l) = nativeSort (remdups l)"
   by (simp add: nativeSort_def sorted_list_of_set_sort_remdups)
 
 lemma [code]: "fMin (fset_of_list (h#t)) = hd (nativeSort (h#t))"
   by (metis fMin_Min hd_sort_Min list.distinct(1) nativeSort_def)
 
 lemma sorted_Max_Cons:
   "l \<noteq> [] \<Longrightarrow>
    sorted (a#l) \<Longrightarrow>
    Max (set (a#l)) = Max (set l)"
   using eq_iff by fastforce
 
 lemma sorted_Max:
   "l \<noteq> [] \<Longrightarrow>
    sorted l \<Longrightarrow>
    Max (set l) = hd (rev l)"
 proof(induct l)
   case Nil
   then show ?case by simp
 next
   case (Cons a l)
   then show ?case
     by (metis sorted_Max_Cons Max_singleton hd_rev last.simps list.set(1) list.simps(15) sorted_simps(2))
 qed
 
 lemma [code]: "fMax (fset_of_list (h#t)) = last (nativeSort (h#t))"
   by (metis Max.set_eq_fold fMax_fold hd_rev list.simps(3) nativeSort_def set_empty2 set_sort sorted_Max sorted_sort)
 
 definition "list_max l = fold max l"
 code_printing constant list_max \<rightharpoonup> (Scala) "_.par.fold((_))(Orderings.max)"
 
 lemma [code]: "fMax (fset_of_list (h#t)) = list_max t h"
   by (metis fMax_fold list_max_def)
 
 definition "list_min l = fold min l"
 code_printing constant list_min \<rightharpoonup> (Scala) "_.par.fold((_))(Orderings.min)"
 
 lemma [code]: "fMin (fset_of_list (h#t)) = list_min t h"
   by (metis fMin_fold list_min_def)
 
 lemma fis_singleton_code [code]: "fis_singleton s = (size s = 1)"
   apply (simp add: fis_singleton_def is_singleton_def)
   by (simp add: card_Suc_eq)
 
 end
diff --git a/thys/Extended_Finite_State_Machines/EFSM.thy b/thys/Extended_Finite_State_Machines/EFSM.thy
--- a/thys/Extended_Finite_State_Machines/EFSM.thy
+++ b/thys/Extended_Finite_State_Machines/EFSM.thy
@@ -1,1492 +1,1492 @@
 section \<open>Extended Finite State Machines\<close>
 
 text\<open>This theory defines extended finite state machines as presented in \<^cite>\<open>"foster2018"\<close>. States
 are indexed by natural numbers, however, since transition matrices are implemented by finite sets,
 the number of reachable states in $S$ is necessarily finite. For ease of implementation, we
 implicitly make the initial state zero for all EFSMs. This allows EFSMs to be represented purely by
 their transition matrix which, in this implementation, is a finite set of tuples of the form
 $((s_1, s_2), t)$ in which $s_1$ is the origin state, $s_2$ is the destination state, and $t$ is a
 transition.\<close>
 
 theory EFSM
   imports "HOL-Library.FSet" Transition FSet_Utils
 begin
 
 declare One_nat_def [simp del]
 
 type_synonym cfstate = nat
 type_synonym inputs = "value list"
 type_synonym outputs = "value option list"
 
 type_synonym action = "(label \<times> inputs)"
 type_synonym execution = "action list"
 type_synonym observation = "outputs list"
 type_synonym transition_matrix = "((cfstate \<times> cfstate) \<times> transition) fset"
 
 no_notation relcomp (infixr "O" 75) and comp (infixl "o" 55)
 
 type_synonym event = "(label \<times> inputs \<times> value list)"
 type_synonym trace = "event list"
 type_synonym log = "trace list"
 
 definition Str :: "string \<Rightarrow> value" where
   "Str s \<equiv> value.Str (String.implode s)"
 
 lemma str_not_num: "Str s \<noteq> Num x1"
   by (simp add: Str_def)
 
 definition S :: "transition_matrix \<Rightarrow> nat fset" where
   "S m = (fimage (\<lambda>((s, s'), t). s) m) |\<union>| fimage (\<lambda>((s, s'), t). s') m"
 
 lemma S_ffUnion: "S e = ffUnion (fimage (\<lambda>((s, s'), _). {|s, s'|}) e)"
   unfolding S_def
   by(induct e, auto)
 
 subsection\<open>Possible Steps\<close>
 text\<open>From a given state, the possible steps for a given action are those transitions with labels
 which correspond to the action label, arities which correspond to the number of inputs, and guards
 which are satisfied by those inputs.\<close>
 
 definition possible_steps :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> label \<Rightarrow> inputs \<Rightarrow> (cfstate \<times> transition) fset" where
   "possible_steps e s r l i = fimage (\<lambda>((origin, dest), t). (dest, t)) (ffilter (\<lambda>((origin, dest), t). origin = s \<and> (Label t) = l \<and> (length i) = (Arity t) \<and> apply_guards (Guards t) (join_ir i r)) e)"
 
 lemma possible_steps_finsert:
 "possible_steps (finsert ((s, s'), t) e) ss r l i = (
   if s = ss \<and> (Label t) = l \<and> (length i) = (Arity t) \<and> apply_guards (Guards t) (join_ir i r) then
     finsert (s', t) (possible_steps e s r l i)
   else
     possible_steps e ss r l i
 )"
   by (simp add: possible_steps_def ffilter_finsert)
 
 
 lemma split_origin:
 "ffilter (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> can_take_transition t i r) e =
 ffilter (\<lambda>((origin, dest), t). Label t = l \<and> can_take_transition t i r) (ffilter (\<lambda>((origin, dest), t). origin = s) e)"
   by auto
 
 lemma split_label:
 "ffilter (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> can_take_transition t i r) e =
 ffilter (\<lambda>((origin, dest), t). origin = s \<and> can_take_transition t i r) (ffilter (\<lambda>((origin, dest), t). Label t = l) e)"
   by auto
 
 lemma possible_steps_empty_guards_false:
   "\<forall>((s1, s2), t) |\<in>| ffilter (\<lambda>((origin, dest), t). Label t = l) e. \<not>can_take_transition t i r \<Longrightarrow>
   possible_steps e s r l i = {||}"
   apply (simp add: possible_steps_def can_take[symmetric] split_label)
-  by (simp add: Abs_ffilter fBall_def Ball_def)
+  by (simp add: Abs_ffilter Ball_def)
 
 lemma fmember_possible_steps: "(s', t) |\<in>| possible_steps e s r l i = (((s, s'), t) \<in> {((origin, dest), t) \<in> fset e. origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)})"
   apply (simp add: possible_steps_def ffilter_def fimage_def Abs_fset_inverse)
   by force
 
 lemma possible_steps_alt_aux:
   "possible_steps e s r l i = {|(d, t)|} \<Longrightarrow>
        ffilter (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)) e = {|((s, d), t)|}"
 proof(induct e)
   case empty
   then show ?case
     by (simp add: fempty_not_finsert possible_steps_def)
 next
   case (insert x e)
   then show ?case
     apply (case_tac x)
     subgoal for a b 
       apply (case_tac a)
       subgoal for aa _
         apply (simp add: possible_steps_def)
         apply (simp add: ffilter_finsert)
         apply (case_tac "aa = s \<and> Label b = l \<and> length i = Arity b \<and> apply_guards (Guards b) (join_ir i r)")
         by auto
       done
     done
 qed
 
 lemma possible_steps_alt: "(possible_steps e s r l i = {|(d, t)|}) = (ffilter
      (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r))
      e = {|((s, d), t)|})"
   apply standard
    apply (simp add: possible_steps_alt_aux)
   by (simp add: possible_steps_def)
 
 lemma possible_steps_alt3: "(possible_steps e s r l i = {|(d, t)|}) = (ffilter
      (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> can_take_transition t i r)
      e = {|((s, d), t)|})"
   apply standard
    apply (simp add: possible_steps_alt_aux can_take)
   by (simp add: possible_steps_def can_take)
 
 lemma possible_steps_alt_atom: "(possible_steps e s r l i = {|dt|}) = (ffilter
      (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> can_take_transition t i r)
      e = {|((s, fst dt), snd dt)|})"
   apply (cases dt)
   by (simp add: possible_steps_alt can_take_transition_def can_take_def)
 
 lemma possible_steps_alt2: "(possible_steps e s r l i = {|(d, t)|}) = (
      (ffilter (\<lambda>((origin, dest), t). Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)) (ffilter (\<lambda>((origin, dest), t). origin = s) e) = {|((s, d), t)|}))"
   apply (simp add: possible_steps_alt)
   apply (simp only: filter_filter)
   apply (rule arg_cong [of "(\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r))"])
   by (rule ext, auto)
 
 lemma possible_steps_single_out:
 "ffilter (\<lambda>((origin, dest), t). origin = s) e = {|((s, d), t)|} \<Longrightarrow>
 Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r) \<Longrightarrow>
 possible_steps e s r l i = {|(d, t)|}"
   apply (simp add: possible_steps_alt2 Abs_ffilter)
   by blast
 
 lemma possible_steps_singleton: "(possible_steps e s r l i = {|(d, t)|}) =
     ({((origin, dest), t) \<in> fset e. origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)} = {((s, d), t)})"
   apply (simp add: possible_steps_alt Abs_ffilter Set.filter_def)
   by fast
 
 lemma possible_steps_apply_guards:
   "possible_steps e s r l i = {|(s', t)|} \<Longrightarrow>
    apply_guards (Guards t) (join_ir i r)"
   apply (simp add: possible_steps_singleton)
   by auto
 
 lemma possible_steps_empty:
   "(possible_steps e s r l i = {||}) = (\<forall>((origin, dest), t) \<in> fset e. origin \<noteq> s \<or> Label t \<noteq> l \<or> \<not> can_take_transition t i r)"
   apply (simp add: can_take_transition_def can_take_def)
   apply (simp add: possible_steps_def Abs_ffilter Set.filter_def)
   by auto
 
 lemma singleton_dest:
   assumes "fis_singleton (possible_steps e s r aa b)"
       and "fthe_elem (possible_steps e s r aa b) = (baa, aba)"
     shows "((s, baa), aba) |\<in>| e"
   using assms
   apply (simp add: fis_singleton_fthe_elem)
   using possible_steps_alt_aux by force
 
 lemma no_outgoing_transitions:
 "ffilter (\<lambda>((s', _), _). s = s') e = {||} \<Longrightarrow>
 possible_steps e s r l i = {||}"
   apply (simp add: possible_steps_def)
   by (smt (verit, best) case_prod_beta eq_ffilter ffilter_empty ffmember_filter)
 
 lemma ffilter_split: "ffilter (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)) e =
                       ffilter (\<lambda>((origin, dest), t). Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)) (ffilter (\<lambda>((origin, dest), t). origin = s) e)"
   by auto
 
 lemma one_outgoing_transition:
   defines "outgoing s \<equiv> (\<lambda>((origin, dest), t). origin = s)"
   assumes prem: "size (ffilter (outgoing s) e) = 1"
   shows "size (possible_steps e s r l i) \<le> 1"
 proof-
   have less_eq_1: "\<And>x::nat. (x \<le> 1) = (x = 1 \<or> x = 0)"
     by auto
   have size_empty: "\<And>f. (size f = 0) = (f = {||})"
     subgoal for f
       by (induct f, auto)
     done
   show ?thesis
     using prem
     apply (simp only: possible_steps_def)
     apply (rule fimage_size_le)
     apply (simp only: ffilter_split outgoing_def[symmetric])
     by (metis (no_types, lifting) size_ffilter)
 qed
 
 subsection\<open>Choice\<close>
 text\<open>Here we define the \texttt{choice} operator which determines whether or not two transitions are
 nondeterministic.\<close>
 
 definition choice :: "transition \<Rightarrow> transition \<Rightarrow> bool" where
   "choice t t' = (\<exists> i r. apply_guards (Guards t) (join_ir i r) \<and> apply_guards (Guards t') (join_ir i r))"
 
 definition choice_alt :: "transition \<Rightarrow> transition \<Rightarrow> bool" where
   "choice_alt t t' = (\<exists> i r. apply_guards (Guards t@Guards t') (join_ir i r))"
 
 lemma choice_alt: "choice t t' = choice_alt t t'"
   by (simp add: choice_def choice_alt_def apply_guards_append)
 
 lemma choice_symmetry: "choice x y = choice y x"
   using choice_def by auto
 
 definition deterministic :: "transition_matrix \<Rightarrow> bool" where
   "deterministic e = (\<forall>s r l i. size (possible_steps e s r l i) \<le> 1)"
 
 lemma deterministic_alt_aux: "size (possible_steps e s r l i) \<le> 1 =(
         possible_steps e s r l i = {||} \<or>
         (\<exists>s' t.
             ffilter
              (\<lambda>((origin, dest), t). origin = s \<and> Label t = l \<and> length i = Arity t \<and> apply_guards (Guards t) (join_ir i r)) e =
             {|((s, s'), t)|}))"
   apply (case_tac "size (possible_steps e s r l i) = 0")
    apply (simp add: fset_equiv)
   apply (case_tac "possible_steps e s r l i = {||}")
    apply simp
   apply (simp only: possible_steps_alt[symmetric])
   by (metis le_neq_implies_less le_numeral_extra(4) less_one prod.collapse size_fsingleton)
 
 lemma deterministic_alt: "deterministic e = (
   \<forall>s r l i.
     possible_steps e s r l i = {||} \<or>
     (\<exists>s' t. ffilter (\<lambda>((origin, dest), t). origin = s \<and> (Label t) = l \<and> (length i) = (Arity t) \<and> apply_guards (Guards t) (join_ir i r)) e = {|((s, s'), t)|})
 )"
   using deterministic_alt_aux
   by (simp add: deterministic_def)
 
 lemma size_le_1: "size f \<le> 1 = (f = {||} \<or> (\<exists>e. f = {|e|}))"
   apply standard
    apply (metis bot.not_eq_extremum gr_implies_not0 le_neq_implies_less less_one size_fsingleton size_fsubset)
   by auto
 
 lemma ffilter_empty_if: "\<forall>x |\<in>| xs. \<not> P x \<Longrightarrow> ffilter P xs = {||}"
   by auto
 
 lemma empty_ffilter: "ffilter P xs = {||} = (\<forall>x |\<in>| xs. \<not> P x)"
   by auto
 
 lemma all_states_deterministic:
 "(\<forall>s l i r.
   ffilter (\<lambda>((origin, dest), t). origin = s \<and> (Label t) = l \<and> can_take_transition t i r) e = {||} \<or>
   (\<exists>x. ffilter (\<lambda>((origin, dest), t). origin = s \<and> (Label t) = l \<and> can_take_transition t i r) e = {|x|})
 ) \<Longrightarrow> deterministic e"
   unfolding deterministic_def
   apply clarify
   subgoal for s r l i
     apply (erule_tac x=s in allE)
     apply (erule_tac x=l in allE)
     apply (erule_tac x=i in allE)
     apply (erule_tac x=r in allE)
     apply (simp only: size_le_1)
     apply (erule disjE)
      apply (rule_tac disjI1)
      apply (simp add: possible_steps_def can_take_transition_def can_take_def)
     apply (erule exE)
     subgoal for x
       apply (case_tac x)
       subgoal for a b
         apply (case_tac a)
         apply simp
         apply (induct e)
          apply auto[1]
         subgoal for _ _ _ ba
           apply (rule disjI2)
           apply (rule_tac x=ba in exI)
           apply (rule_tac x=b in exI)
           by (simp add: possible_steps_def can_take_transition_def[symmetric] can_take_def[symmetric])
         done
       done
     done
   done
 
 lemma deterministic_finsert:
 "\<forall>i r l.
 \<forall>((a, b), t) |\<in>| ffilter (\<lambda>((origin, dest), t). origin = s) (finsert ((s, s'), t') e).
 Label t = l \<and> can_take_transition t i r \<longrightarrow> \<not> can_take_transition t' i r \<Longrightarrow>
 deterministic e \<Longrightarrow>
 deterministic (finsert ((s, s'), t') e)"
   apply (simp add: deterministic_def possible_steps_finsert can_take del: size_fset_overloaded_simps)
   apply clarify
   subgoal for r i
     apply (erule_tac x=s in allE)
     apply (erule_tac x=r in allE)
     apply (erule_tac x="Label t'" in allE)
     apply (erule_tac x=i in allE)
     apply (erule_tac x=r in allE)
     apply (erule_tac x=i in allE)
     apply (erule_tac x="Label t'" in allE)
     by auto
   done
 
 lemma ffilter_fBall: "(\<forall>x |\<in>| xs. P x) = (ffilter P xs = xs)"
   by auto
 
 lemma fsubset_if: "\<forall>x. x |\<in>| f1 \<longrightarrow> x |\<in>| f2 \<Longrightarrow> f1 |\<subseteq>| f2"
   by auto
 
 lemma in_possible_steps: "(((s, s'), t)|\<in>|e \<and> Label t = l \<and> can_take_transition t i r) = ((s', t) |\<in>| possible_steps e s r l i)"
   apply (simp add: fmember_possible_steps)
   by (simp add: can_take_def can_take_transition_def)
 
 lemma possible_steps_can_take_transition:
   "(s2, t1) |\<in>| possible_steps e1 s1 r l i \<Longrightarrow> can_take_transition t1 i r"
   using in_possible_steps by blast
 
 lemma not_deterministic:
   "\<exists>s l i r.
     \<exists>d1 d2 t1 t2.
       d1 \<noteq> d2 \<and> t1 \<noteq> t2 \<and>
       ((s, d1), t1) |\<in>| e \<and>
       ((s, d2), t2) |\<in>| e \<and>
       Label t1 = Label t2 \<and>
       can_take_transition t1 i r \<and>
       can_take_transition t2 i r \<Longrightarrow>
   \<not>deterministic e"
   apply (simp add: deterministic_def not_le del: size_fset_overloaded_simps)
   apply clarify
   subgoal for s i r d1 d2 t1 t2
     apply (rule_tac x=s in exI)
     apply (rule_tac x=r in exI)
     apply (rule_tac x="Label t1" in exI)
     apply (rule_tac x=i in exI)
     apply (case_tac "(d1, t1) |\<in>| possible_steps e s r (Label t1) i")
      defer using in_possible_steps apply blast
     apply (case_tac "(d2, t2) |\<in>| possible_steps e s r (Label t1) i")
      apply (metis fempty_iff fsingleton_iff not_le_imp_less prod.inject size_le_1)
     using in_possible_steps by force
   done
 
 lemma not_deterministic_conv:
   "\<not>deterministic e \<Longrightarrow>
   \<exists>s l i r.
     \<exists>d1 d2 t1 t2.
       (d1 \<noteq> d2 \<or> t1 \<noteq> t2) \<and>
       ((s, d1), t1) |\<in>| e \<and>
       ((s, d2), t2) |\<in>| e \<and>
       Label t1 = Label t2 \<and>
       can_take_transition t1 i r \<and>
       can_take_transition t2 i r"
   apply (simp add: deterministic_def not_le del: size_fset_overloaded_simps)
   apply clarify
   subgoal for s r l i
     apply (case_tac "\<exists>e1 e2 f'. e1 \<noteq> e2 \<and> possible_steps e s r l i = finsert e1 (finsert e2 f')")
      defer using size_gt_1 apply blast
     apply (erule exE)+
     subgoal for e1 e2 f'
       apply (case_tac e1, case_tac e2)
       subgoal for a b aa ba
         apply (simp del: size_fset_overloaded_simps)
         apply (rule_tac x=s in exI)
         apply (rule_tac x=i in exI)
         apply (rule_tac x=r in exI)
         apply (rule_tac x=a in exI)
         apply (rule_tac x=aa in exI)
         apply (rule_tac x=b in exI)
         apply (rule_tac x=ba in exI)
         by (metis finsertCI in_possible_steps)
       done
     done
   done
 
 lemma deterministic_if:
 "\<nexists>s l i r.
   \<exists>d1 d2 t1 t2.
     (d1 \<noteq> d2 \<or> t1 \<noteq> t2) \<and>
     ((s, d1), t1) |\<in>| e \<and>
     ((s, d2), t2) |\<in>| e \<and>
     Label t1 = Label t2 \<and>
     can_take_transition t1 i r \<and>
     can_take_transition t2 i r \<Longrightarrow>
   deterministic e"
   using not_deterministic_conv by blast
 
 lemma "\<forall>l i r.
   (\<forall>((s, s'), t) |\<in>| e. Label t = l \<and> can_take_transition t i r \<and>
   (\<nexists>t' s''. ((s, s''), t') |\<in>| e \<and> (s' \<noteq> s'' \<or> t' \<noteq> t) \<and> Label t' = l \<and> can_take_transition t' i r))
  \<Longrightarrow> deterministic e"
   apply (simp add: deterministic_def del: size_fset_overloaded_simps)
   apply (rule allI)+
   apply (simp only: size_le_1 possible_steps_empty)
   apply (case_tac "\<exists>t s'. ((s, s'), t)|\<in>|e \<and> Label t = l \<and> can_take_transition t i r")
    defer apply fastforce
   apply (rule disjI2)
   apply clarify
   apply (rule_tac x="(s', t)" in exI)
   apply standard
    defer apply (meson fempty_fsubsetI finsert_fsubset in_possible_steps)
   apply standard
   apply (case_tac x)
   apply (simp add: in_possible_steps[symmetric])
   apply (erule_tac x="Label t" in allE)
   apply (erule_tac x=i in allE)
   apply (erule_tac x=r in allE)
   apply (erule_tac x="((s, s'), t)" in fBallE)
    defer apply simp
   apply simp
   apply (erule_tac x=b in allE)
   apply simp
   apply (erule_tac x=a in allE)
   by simp
 
 definition "outgoing_transitions e s = ffilter (\<lambda>((o, _), _). o = s) e"
 
 lemma in_outgoing: "((s1, s2), t) |\<in>| outgoing_transitions e s = (((s1, s2), t) |\<in>| e \<and> s1 = s)"
   by (auto simp add: outgoing_transitions_def)
 
 lemma outgoing_transitions_deterministic:
   "\<forall>s.
     \<forall>((s1, s2), t) |\<in>| outgoing_transitions e s.
       \<forall>((s1', s2'), t') |\<in>| outgoing_transitions e s.
         s2 \<noteq> s2' \<or> t \<noteq> t' \<longrightarrow> Label t = Label t' \<longrightarrow> \<not> choice t t' \<Longrightarrow> deterministic e"
   apply (rule deterministic_if)
   apply simp
   apply (rule allI)
   subgoal for s
     apply (erule_tac x=s in allE)
-    apply (simp add: fBall_def Ball_def)
+    apply (simp add: Ball_def)
     apply (rule allI)+
     subgoal for i r d1 d2 t1
       apply (erule_tac x=s in allE)
       apply (erule_tac x=d1 in allE)
       apply (erule_tac x=t1 in allE)
       apply (rule impI, rule allI)
       subgoal for t2
         apply (case_tac "((s, d1), t1) \<in> fset (outgoing_transitions e s)")
          apply simp
          apply (erule_tac x=s in allE)
          apply (erule_tac x=d2 in allE)
          apply (erule_tac x=t2 in allE)
          apply (simp add: outgoing_transitions_def choice_def can_take)
          apply meson
         by (simp add: outgoing_transitions_def)
       done
     done
   done
 
 lemma outgoing_transitions_deterministic2: "(\<And>s a b ba aa bb bc.
        ((a, b), ba) |\<in>| outgoing_transitions e s \<Longrightarrow>
        ((aa, bb), bc) |\<in>| (outgoing_transitions e s) - {|((a, b), ba)|} \<Longrightarrow> b \<noteq> bb \<or> ba \<noteq> bc \<Longrightarrow> \<not>choice ba bc)
         \<Longrightarrow> deterministic e"
   apply (rule outgoing_transitions_deterministic)
   by blast
 
 lemma outgoing_transitions_fprod_deterministic:
 "(\<And>s b ba bb bc.
 (((s, b), ba), ((s, bb), bc)) \<in> fset (outgoing_transitions e s) \<times> fset (outgoing_transitions e s)
 \<Longrightarrow> b \<noteq> bb \<or> ba \<noteq> bc \<Longrightarrow> Label ba = Label bc \<Longrightarrow> \<not>choice ba bc)
 \<Longrightarrow> deterministic e"
   apply (rule outgoing_transitions_deterministic)
   apply clarify
   by (metis SigmaI in_outgoing)
 
 text\<open>The \texttt{random\_member} function returns a random member from a finite set, or
 \texttt{None}, if the set is empty.\<close>
 definition random_member :: "'a fset \<Rightarrow> 'a option" where
   "random_member f = (if f = {||} then None else Some (Eps (\<lambda>x. x |\<in>| f)))"
 
 lemma random_member_nonempty: "s \<noteq> {||} = (random_member s \<noteq> None)"
   by (simp add: random_member_def)
 
 lemma random_member_singleton [simp]: "random_member {|a|} = Some a"
   by (simp add: random_member_def)
 
 lemma random_member_is_member:
   "random_member ss = Some s \<Longrightarrow> s |\<in>| ss"
   apply (simp add: random_member_def)
   by (metis equalsffemptyI option.distinct(1) option.inject verit_sko_ex_indirect)
 
 lemma random_member_None[simp]: "random_member ss = None = (ss = {||})"
   by (simp add: random_member_def)
 
 lemma random_member_empty[simp]: "random_member {||} = None"
   by simp
 
 definition step :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> label \<Rightarrow> inputs \<Rightarrow> (transition \<times> cfstate \<times> outputs \<times> registers) option" where
   "step e s r l i = (case random_member (possible_steps e s r l i) of
       None \<Rightarrow> None |
       Some (s', t) \<Rightarrow>  Some (t, s', evaluate_outputs t i r, evaluate_updates t i r)
   )"
 
 lemma possible_steps_not_empty_iff:
   "step e s r a b \<noteq> None \<Longrightarrow>
    \<exists>aa ba. (aa, ba) |\<in>| possible_steps e s r a b"
   apply (simp add: step_def)
   apply (case_tac "possible_steps e s r a b")
    apply (simp add: random_member_def)
   by auto
 
 lemma step_member: "step e s r l i = Some (t, s', p, r') \<Longrightarrow> (s', t) |\<in>| possible_steps e s r l i"
   apply (simp add: step_def)
   apply (case_tac "random_member (possible_steps e s r l i)")
    apply simp
   subgoal for a by (case_tac a, simp add: random_member_is_member)
   done
 
 lemma step_outputs: "step e s r l i = Some (t, s', p, r') \<Longrightarrow> evaluate_outputs t i r = p"
   apply (simp add: step_def)
   apply (case_tac "random_member (possible_steps e s r l i)")
   by auto
 
 lemma step:
   "possibilities = (possible_steps e s r l i) \<Longrightarrow>
    random_member possibilities = Some (s', t) \<Longrightarrow>
    evaluate_outputs t i r = p \<Longrightarrow>
    evaluate_updates t i r = r' \<Longrightarrow>
    step e s r l i = Some (t, s', p, r')"
   by (simp add: step_def)
 
 lemma step_None: "step e s r l i = None = (possible_steps e s r l i = {||})"
   by (simp add: step_def prod.case_eq_if random_member_def)
 
 lemma step_Some: "step e s r l i = Some (t, s', p, r') =
   (
     random_member (possible_steps e s r l i) = Some (s', t) \<and>
     evaluate_outputs t i r = p \<and>
     evaluate_updates t i r = r'
   )"
   apply (simp add: step_def)
   apply (case_tac "random_member (possible_steps e s r l i)")
    apply simp
   subgoal for a by (case_tac a, auto)
   done
 
 lemma no_possible_steps_1:
   "possible_steps e s r l i = {||} \<Longrightarrow> step e s r l i = None"
   by (simp add: step_def random_member_def)
 
 subsection\<open>Execution Observation\<close>
 text\<open>One of the key features of this formalisation of EFSMs is their ability to produce
 \emph{outputs}, which represent function return values. When action sequences are executed in an
 EFSM, they produce a corresponding \emph{observation}.\<close>
 
 text_raw\<open>\snip{observe}{1}{2}{%\<close>
 fun observe_execution :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> outputs list" where
   "observe_execution _ _ _ [] = []" |
   "observe_execution e s r ((l, i)#as)  = (
     let viable = possible_steps e s r l i in
     if viable = {||} then
       []
     else
       let (s', t) = Eps (\<lambda>x. x |\<in>| viable) in
       (evaluate_outputs t i r)#(observe_execution e s' (evaluate_updates t i r) as)
     )"
 text_raw\<open>}%endsnip\<close>
 
 lemma observe_execution_step_def: "observe_execution e s r ((l, i)#as)  = (
     case step e s r l i of
       None \<Rightarrow> []|
       Some (t, s', p, r') \<Rightarrow> p#(observe_execution e s' r' as)
     )"
   apply (simp add: step_def)
   apply (case_tac "possible_steps e s r l i")
    apply simp
   subgoal for x S'
     apply (simp add: random_member_def)
     apply (case_tac "SOME xa. xa = x \<or> xa |\<in>| S'")
     by simp
   done
 
 lemma observe_execution_first_outputs_equiv:
   "observe_execution e1 s1 r1 ((l, i) # ts) = observe_execution e2 s2 r2 ((l, i) # ts) \<Longrightarrow>
    step e1 s1 r1 l i = Some (t, s', p, r') \<Longrightarrow>
    \<exists>(s2', t2)|\<in>|possible_steps e2 s2 r2 l i. evaluate_outputs t2 i r2 = p"
   apply (simp only: observe_execution_step_def)
   apply (case_tac "step e2 s2 r2 l i")
    apply simp
   subgoal for a
     apply simp
     apply (case_tac a)
     apply clarsimp
     by (meson step_member case_prodI rev_fBexI step_outputs)
   done
 
 lemma observe_execution_step:
   "step e s r (fst h) (snd h) = Some (t, s', p, r') \<Longrightarrow>
    observe_execution e s' r' es = obs \<Longrightarrow>
    observe_execution e s r (h#es) = p#obs"
   apply (cases h, simp add: step_def)
   apply (case_tac "possible_steps e s r a b = {||}")
    apply simp
   subgoal for a b
     apply (case_tac "SOME x. x |\<in>| possible_steps e s r a b")
     by (simp add: random_member_def)
   done
 
 lemma observe_execution_possible_step:
   "possible_steps e s r (fst h) (snd h) = {|(s', t)|} \<Longrightarrow>
    apply_outputs (Outputs t) (join_ir (snd h) r) = p \<Longrightarrow>
    apply_updates (Updates t) (join_ir (snd h) r) r = r' \<Longrightarrow>
    observe_execution e s' r' es = obs \<Longrightarrow>
    observe_execution e s r (h#es) = p#obs"
   by (simp add: observe_execution_step step)
 
 lemma observe_execution_no_possible_step:
   "possible_steps e s r (fst h) (snd h) = {||} \<Longrightarrow>
    observe_execution e s r (h#es) = []"
   by (cases h, simp)
 
 lemma observe_execution_no_possible_steps:
   "possible_steps e1 s1 r1 (fst h) (snd h) = {||} \<Longrightarrow>
    possible_steps e2 s2 r2 (fst h) (snd h) = {||} \<Longrightarrow>
    (observe_execution e1 s1 r1 (h#t)) = (observe_execution e2 s2 r2 (h#t))"
   by (simp add: observe_execution_no_possible_step)
 
 lemma observe_execution_one_possible_step:
   "possible_steps e1 s1 r (fst h) (snd h) = {|(s1', t1)|} \<Longrightarrow>
    possible_steps e2 s2 r (fst h) (snd h) = {|(s2', t2)|} \<Longrightarrow>
    apply_outputs (Outputs t1) (join_ir (snd h) r) = apply_outputs (Outputs t2) (join_ir (snd h) r) \<Longrightarrow>
 
    apply_updates (Updates t1) (join_ir (snd h) r) r = r' \<Longrightarrow>
    apply_updates (Updates t2) (join_ir (snd h) r) r = r' \<Longrightarrow>
    (observe_execution e1 s1' r' t) = (observe_execution e2 s2' r' t) \<Longrightarrow>
    (observe_execution e1 s1 r (h#t)) = (observe_execution e2 s2 r (h#t))"
   by (simp add: observe_execution_possible_step)
 
 subsubsection\<open>Utilities\<close>
 text\<open>Here we define some utility functions to access the various key properties of a given EFSM.\<close>
 
 definition max_reg :: "transition_matrix \<Rightarrow> nat option" where
   "max_reg e = (let maxes = (fimage (\<lambda>(_, t). Transition.max_reg t) e) in if maxes = {||} then None else fMax maxes)"
 
 definition enumerate_ints :: "transition_matrix \<Rightarrow> int set" where
   "enumerate_ints e = \<Union> (image (\<lambda>(_, t). Transition.enumerate_ints t) (fset e))"
 
 definition max_int :: "transition_matrix \<Rightarrow> int" where
   "max_int e = Max (insert 0 (enumerate_ints e))"
 
 definition max_output :: "transition_matrix \<Rightarrow> nat" where
   "max_output e = fMax (fimage (\<lambda>(_, t). length (Outputs t)) e)"
 
 definition all_regs :: "transition_matrix \<Rightarrow> nat set" where
   "all_regs e = \<Union> (image (\<lambda>(_, t). enumerate_regs t) (fset e))"
 
 text_raw\<open>\snip{finiteRegs}{1}{2}{%\<close>
 lemma finite_all_regs: "finite (all_regs e)"
 text_raw\<open>}%endsnip\<close>
   apply (simp add: all_regs_def enumerate_regs_def)
   apply clarify
   apply standard
    apply (rule finite_UnI)+
   using GExp.finite_enumerate_regs apply blast
   using AExp.finite_enumerate_regs apply blast
    apply (simp add: AExp.finite_enumerate_regs prod.case_eq_if)
   by auto
 
 definition max_input :: "transition_matrix \<Rightarrow> nat option" where
   "max_input e = fMax (fimage (\<lambda>(_, t). Transition.max_input t) e)"
 
 fun maxS :: "transition_matrix \<Rightarrow> nat" where
   "maxS t = (if t = {||} then 0 else fMax ((fimage (\<lambda>((origin, dest), t). origin) t) |\<union>| (fimage (\<lambda>((origin, dest), t). dest) t)))"
 
 subsection\<open>Execution Recognition\<close>
 text\<open>The \texttt{recognises} function returns true if the given EFSM recognises a given execution.
 That is, the EFSM is able to respond to each event in sequence. There is no restriction on the
 outputs produced. When a recognised execution is observed, it produces an accepted trace of the
 EFSM.\<close>
 
 text_raw\<open>\snip{recognises}{1}{2}{%\<close>
 inductive recognises_execution :: "transition_matrix \<Rightarrow> nat \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   base [simp]: "recognises_execution e s r []" |
   step: "\<exists>(s', T) |\<in>| possible_steps e s r l i.
          recognises_execution e s' (evaluate_updates T i r) t \<Longrightarrow>
          recognises_execution e s r ((l, i)#t)"
 text_raw\<open>}%endsnip\<close>
 
 abbreviation "recognises e t \<equiv> recognises_execution e 0 <> t"
 
 definition "E e = {x. recognises e x}"
 
 lemma no_possible_steps_rejects:
   "possible_steps e s r l i = {||} \<Longrightarrow> \<not> recognises_execution e s r ((l, i)#t)"
   apply clarify
   by (rule recognises_execution.cases, auto)
 
 lemma recognises_step_equiv: "recognises_execution e s r ((l, i)#t) =
    (\<exists>(s', T) |\<in>| possible_steps e s r l i. recognises_execution e s' (evaluate_updates T i r) t)"
   apply standard
    apply (rule recognises_execution.cases)
   by (auto simp: recognises_execution.step)
 
 fun recognises_prim :: "transition_matrix \<Rightarrow> nat \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   "recognises_prim e s r [] = True" |
   "recognises_prim e s r ((l, i)#t) = (
     let poss_steps = possible_steps e s r l i in
     (\<exists>(s', T) |\<in>| poss_steps. recognises_prim e s' (evaluate_updates T i r) t)
   )"
 
 lemma recognises_prim [code]: "recognises_execution e s r t = recognises_prim e s r t"
 proof(induct t arbitrary: r s)
   case Nil
   then show ?case
     by simp
 next
   case (Cons h t)
   then show ?case
     apply (cases h)
     apply simp
     apply standard
      apply (rule recognises_execution.cases, simp)
       apply simp
      apply auto[1]
     using recognises_execution.step by blast
 qed
 
 lemma recognises_single_possible_step:
   assumes "possible_steps e s r l i = {|(s', t)|}"
       and "recognises_execution e s' (evaluate_updates t i r) trace"
     shows "recognises_execution e s r ((l, i)#trace)"
   apply (rule recognises_execution.step)
   using assms by auto
 
 lemma recognises_single_possible_step_atomic:
   assumes "possible_steps e s r (fst h) (snd h) = {|(s', t)|}"
       and "recognises_execution e s' (apply_updates (Updates t) (join_ir (snd h) r) r) trace"
     shows "recognises_execution e s r (h#trace)"
   by (metis assms prod.collapse recognises_single_possible_step)
 
 lemma recognises_must_be_possible_step:
   "recognises_execution e s r (h # t) \<Longrightarrow>
    \<exists>aa ba. (aa, ba) |\<in>| possible_steps e s r (fst h) (snd h)"
   using recognises_step_equiv by fastforce
 
 lemma recognises_possible_steps_not_empty:
   "recognises_execution e s r (h#t) \<Longrightarrow> possible_steps e s r (fst h) (snd h) \<noteq> {||}"
   apply (rule recognises_execution.cases)
   by auto
 
 lemma recognises_must_be_step:
   "recognises_execution e s r (h#ts) \<Longrightarrow>
    \<exists>t s' p d'. step e s r (fst h) (snd h) = Some (t, s', p, d')"
   apply (cases h)
   subgoal for a b 
     apply (simp add: recognises_step_equiv step_def)
     apply clarify
     apply (case_tac "(possible_steps e s r a b)")
      apply (simp add: random_member_def)
     apply (simp add: random_member_def)
     subgoal for _ _ x S' apply (case_tac "SOME xa. xa = x \<or> xa |\<in>| S'")
       by simp
     done
   done
 
 lemma recognises_cons_step:
   "recognises_execution e s r (h # t) \<Longrightarrow> step e s r (fst h) (snd h) \<noteq>  None"
   by (simp add: recognises_must_be_step)
 
 lemma no_step_none:
   "step e s r aa ba = None \<Longrightarrow> \<not> recognises_execution e s r ((aa, ba) # p)"
   using recognises_cons_step by fastforce
 
 lemma step_none_rejects:
   "step e s r (fst h) (snd h) = None \<Longrightarrow> \<not> recognises_execution e s r (h#t)"
   using no_step_none surjective_pairing by fastforce
 
 lemma trace_reject:
   "(\<not> recognises_execution e s r ((l, i)#t)) = (possible_steps e s r l i = {||} \<or> (\<forall>(s', T) |\<in>| possible_steps e s r l i. \<not> recognises_execution e s' (evaluate_updates T i r) t))"
   using recognises_prim by fastforce
 
 lemma trace_reject_no_possible_steps_atomic:
   "possible_steps e s r (fst a) (snd a) = {||} \<Longrightarrow> \<not> recognises_execution e s r (a#t)"
   using recognises_possible_steps_not_empty by auto
 
 lemma trace_reject_later:
   "\<forall>(s', T) |\<in>| possible_steps e s r l i. \<not> recognises_execution e s' (evaluate_updates T i r) t \<Longrightarrow>
    \<not> recognises_execution e s r ((l, i)#t)"
   using trace_reject by auto
 
 lemma recognition_prefix_closure: "recognises_execution e s r (t@t') \<Longrightarrow> recognises_execution e s r t"
 proof(induct t arbitrary: s r)
   case (Cons a t)
   then show ?case
     apply (cases a, clarsimp)
     apply (rule recognises_execution.cases)
       apply simp
      apply simp
     by (rule recognises_execution.step, auto)
 qed auto
 
 lemma rejects_prefix: "\<not> recognises_execution e s r t \<Longrightarrow> \<not> recognises_execution e s r (t @ t')"
   using recognition_prefix_closure by blast
 
 lemma recognises_head: "recognises_execution e s r (h#t) \<Longrightarrow> recognises_execution e s r [h]"
   by (simp add: recognition_prefix_closure)
 
 subsubsection\<open>Trace Acceptance\<close>
 text\<open>The \texttt{accepts} function returns true if the given EFSM accepts a given trace. That is,
 the EFSM is able to respond to each event in sequence \emph{and} is able to produce the expected
 output. Accepted traces represent valid runs of an EFSM.\<close>
 
 text_raw\<open>\snip{accepts}{1}{2}{%\<close>
 inductive accepts_trace :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> trace \<Rightarrow> bool" where
   base [simp]: "accepts_trace e s r []" |
   step: "\<exists>(s', T) |\<in>| possible_steps e s r l i.
          evaluate_outputs T i r = map Some p \<and> accepts_trace e s' (evaluate_updates T i r) t \<Longrightarrow>
          accepts_trace e s r ((l, i, p)#t)"
 text_raw\<open>}%endsnip\<close>
 
 text_raw\<open>\snip{T}{1}{2}{%\<close>
 definition T :: "transition_matrix \<Rightarrow> trace set" where
   "T e = {t. accepts_trace e 0 <> t}"
 text_raw\<open>}%endsnip\<close>
 
 abbreviation "rejects_trace e s r t \<equiv> \<not> accepts_trace e s r t"
 
 lemma accepts_trace_step:
   "accepts_trace e s r ((l, i, p)#t) = (\<exists>(s', T) |\<in>| possible_steps e s r l i.
          evaluate_outputs T i r = map Some p \<and>
          accepts_trace e s' (evaluate_updates T i r) t)"
   apply standard
   by (rule accepts_trace.cases, auto simp: accepts_trace.step)
 
 lemma accepts_trace_exists_possible_step:
   "accepts_trace e1 s1 r1 ((aa, b, c) # t) \<Longrightarrow>
        \<exists>(s1', t1)|\<in>|possible_steps e1 s1 r1 aa b.
           evaluate_outputs t1 b r1 = map Some c"
   using accepts_trace_step by auto
 
 lemma rejects_trace_step:
 "rejects_trace e s r ((l, i, p)#t) = (
   (\<forall>(s', T) |\<in>| possible_steps e s r l i.  evaluate_outputs T i r \<noteq> map Some p \<or> rejects_trace e s' (evaluate_updates T i r) t)
 )"
   apply (simp add: accepts_trace_step)
   by auto
 
 definition accepts_log :: "trace set \<Rightarrow> transition_matrix \<Rightarrow> bool" where
   "accepts_log l e = (\<forall>t \<in> l. accepts_trace e 0 <> t)"
 
 text_raw\<open>\snip{prefixClosure}{1}{2}{%\<close>
 lemma prefix_closure: "accepts_trace e s r (t@t') \<Longrightarrow> accepts_trace e s r t"
 text_raw\<open>}%endsnip\<close>
 proof(induct t arbitrary: s r)
 next
   case (Cons a t)
   then show ?case
     apply (cases a, clarsimp)
     apply (simp add: accepts_trace_step)
     by auto
 qed auto
 
 text\<open>For code generation, it is much more efficient to re-implement the \texttt{accepts\_trace}
 function primitively than to use the code generator's default setup for inductive definitions.\<close>
 fun accepts_trace_prim :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> trace \<Rightarrow> bool" where
   "accepts_trace_prim _ _ _ [] = True" |
   "accepts_trace_prim e s r ((l, i, p)#t) = (
     let poss_steps = possible_steps e s r l i in
     if fis_singleton poss_steps then
       let (s', T) = fthe_elem poss_steps in
       if evaluate_outputs T i r = map Some p then
         accepts_trace_prim e s' (evaluate_updates T i r) t
       else False
     else
       (\<exists>(s', T) |\<in>| poss_steps.
          evaluate_outputs T i r = (map Some p) \<and>
          accepts_trace_prim e s' (evaluate_updates T i r) t))"
 
 lemma accepts_trace_prim [code]: "accepts_trace e s r l = accepts_trace_prim e s r l"
 proof(induct l arbitrary: s r)
   case (Cons a l)
   then show ?case
     apply (cases a)
     apply (simp add: accepts_trace_step Let_def fis_singleton_alt)
     by auto
 qed auto
 
 subsection\<open>EFSM Comparison\<close>
 text\<open>Here, we define some different metrics of EFSM equality.\<close>
 
 subsubsection\<open>State Isomporphism\<close>
 text\<open>Two EFSMs are isomorphic with respect to states if there exists a bijective function between
 the state names of the two EFSMs, i.e. the only difference between the two models is the way the
 states are indexed.\<close>
 
 definition isomorphic :: "transition_matrix \<Rightarrow> transition_matrix \<Rightarrow> bool" where
   "isomorphic e1 e2 = (\<exists>f. bij f \<and> (\<forall>((s1, s2), t) |\<in>| e1. ((f s1, f s2), t) |\<in>| e2))"
 
 subsubsection\<open>Register Isomporphism\<close>
 text\<open>Two EFSMs are isomorphic with respect to registers if there exists a bijective function between
 the indices of the registers in the two EFSMs, i.e. the only difference between the two models is
 the way the registers are indexed.\<close>
 definition rename_regs :: "(nat \<Rightarrow> nat) \<Rightarrow> transition_matrix \<Rightarrow> transition_matrix" where
   "rename_regs f e = fimage (\<lambda>(tf, t). (tf, Transition.rename_regs f t)) e"
 
 definition eq_upto_rename_strong :: "transition_matrix \<Rightarrow> transition_matrix \<Rightarrow> bool" where
   "eq_upto_rename_strong e1 e2 = (\<exists>f. bij f \<and> rename_regs f e1 = e2)"
 
 subsubsection\<open>Trace Simulation\<close>
 text\<open>An EFSM, $e_1$ simulates another EFSM $e_2$ if there is a function between the states of the
 states of $e_1$ and $e_1$ such that in each state, if $e_1$ can respond to the event and produce
 the correct output, so can $e_2$.\<close>
 
 text_raw\<open>\snip{traceSim}{1}{2}{%\<close>
 inductive trace_simulation :: "(cfstate \<Rightarrow> cfstate) \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow>
 transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> trace \<Rightarrow> bool" where
   base: "s2 = f s1 \<Longrightarrow> trace_simulation f e1 s1 r1 e2 s2 r2 []" |
   step: "s2 = f s1 \<Longrightarrow>
          \<forall>(s1', t1) |\<in>| ffilter (\<lambda>(s1', t1). evaluate_outputs t1 i r1 = map Some o) (possible_steps e1 s1 r1 l i).
            \<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i. evaluate_outputs t2 i r2 = map Some o \<and>
             trace_simulation f e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es \<Longrightarrow>
          trace_simulation f e1 s1 r1 e2 s2 r2 ((l, i, o)#es)"
 text_raw\<open>}%endsnip\<close>
 
 lemma trace_simulation_step:
 "trace_simulation f e1 s1 r1 e2 s2 r2 ((l, i, o)#es) = (
   (s2 = f s1) \<and> (\<forall>(s1', t1) |\<in>| ffilter (\<lambda>(s1', t1). evaluate_outputs t1 i r1 = map Some o) (possible_steps e1 s1 r1 l i).
          (\<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i. evaluate_outputs t2 i r2 = map Some o \<and>
          trace_simulation f e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es))
 )"
   apply standard
    apply (rule trace_simulation.cases, simp+)
   apply (rule trace_simulation.step)
    apply simp
-  by blast
+  by fastforce
 
 lemma trace_simulation_step_none:
   "s2 = f s1 \<Longrightarrow>
    \<nexists>(s1', t1) |\<in>| possible_steps e1 s1 r1 l i. evaluate_outputs t1 i r1 = map Some o \<Longrightarrow>
    trace_simulation f e1 s1 r1 e2 s2 r2 ((l, i, o)#es)"
   apply (rule trace_simulation.step)
    apply simp
   apply (case_tac "ffilter (\<lambda>(s1', t1). evaluate_outputs t1 i r1 = map Some o) (possible_steps e1 s1 r1 l i)")
    apply simp
   by fastforce
 
 definition "trace_simulates e1 e2 = (\<exists>f. \<forall>t. trace_simulation f e1 0 <> e2 0 <> t)"
 
 lemma rejects_trace_simulation:
   "rejects_trace e2 s2 r2 t \<Longrightarrow>
    accepts_trace e1 s1 r1 t \<Longrightarrow>
    \<not>trace_simulation f e1 s1 r1 e2 s2 r2 t"
 proof(induct t arbitrary: s1 r1 s2 r2)
   case Nil
   then show ?case
     using accepts_trace.base by blast
 next
   case (Cons a t)
   then show ?case
     apply (cases a)
     apply (simp add: rejects_trace_step)
     apply (simp add: accepts_trace_step)
     apply clarify
     apply (rule trace_simulation.cases)
       apply simp
      apply simp
     apply clarsimp
     subgoal for l o _ _ i
-      by fastforce
+      by blast
     done
 qed
 
 lemma accepts_trace_simulation:
   "accepts_trace e1 s1 r1 t \<Longrightarrow>
    trace_simulation f e1 s1 r1 e2 s2 r2 t \<Longrightarrow>
    accepts_trace e2 s2 r2 t"
   using rejects_trace_simulation by blast
 
 lemma simulates_trace_subset: "trace_simulates e1 e2 \<Longrightarrow> T e1 \<subseteq> T e2"
   using T_def accepts_trace_simulation trace_simulates_def by fastforce
 
 subsubsection\<open>Trace Equivalence\<close>
 text\<open>Two EFSMs are trace equivalent if they accept the same traces. This is the intuitive definition
 of ``observable equivalence'' between the behaviours of the two models. If two EFSMs are trace
 equivalent, there is no trace which can distinguish the two.\<close>
 
 text_raw\<open>\snip{traceEquiv}{1}{2}{%\<close>
 definition "trace_equivalent e1 e2 = (T e1 = T e2)"
 text_raw\<open>}%endsnip\<close>
 
 text_raw\<open>\snip{simEquiv}{1}{2}{%\<close>
 lemma simulation_implies_trace_equivalent:
   "trace_simulates e1 e2 \<Longrightarrow> trace_simulates e2 e1 \<Longrightarrow> trace_equivalent e1 e2"
 text_raw\<open>}%endsnip\<close>
   using simulates_trace_subset trace_equivalent_def by auto
 
 lemma trace_equivalent_reflexive: "trace_equivalent e1 e1"
   by (simp add: trace_equivalent_def)
 
 lemma trace_equivalent_symmetric:
   "trace_equivalent e1 e2 = trace_equivalent e2 e1"
   using trace_equivalent_def by auto
 
 lemma trace_equivalent_transitive:
   "trace_equivalent e1 e2 \<Longrightarrow>
    trace_equivalent e2 e3 \<Longrightarrow>
    trace_equivalent e1 e3"
   by (simp add: trace_equivalent_def)
 
 text\<open>Two EFSMs are trace equivalent if they accept the same traces.\<close>
 lemma trace_equivalent:
   "\<forall>t. accepts_trace e1 0 <> t = accepts_trace e2 0 <> t \<Longrightarrow> trace_equivalent e1 e2"
   by (simp add: T_def trace_equivalent_def)
 
 lemma accepts_trace_step_2: "(s2', t2) |\<in>| possible_steps e2 s2 r2 l i \<Longrightarrow>
        accepts_trace e2 s2' (evaluate_updates t2 i r2) t \<Longrightarrow>
        evaluate_outputs t2 i r2 = map Some p \<Longrightarrow>
        accepts_trace e2 s2 r2 ((l, i, p)#t)"
   by (rule accepts_trace.step, auto)
 
 subsubsection\<open>Execution Simulation\<close>
 text\<open>Execution simulation is similar to trace simulation but for executions rather than traces.
 Execution simulation has no notion of ``expected'' output. It simply requires that the simulating
 EFSM must be able to produce equivalent output for each action.\<close>
 
 text_raw\<open>\snip{execSim}{1}{2}{%\<close>
 inductive execution_simulation :: "(cfstate \<Rightarrow> cfstate) \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow>
 registers \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   base: "s2 = f s1 \<Longrightarrow> execution_simulation f e1 s1 r1 e2 s2 r2 []" |
   step: "s2 = f s1 \<Longrightarrow>
          \<forall>(s1', t1) |\<in>| (possible_steps e1 s1 r1 l i).
            \<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i.
             evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
             execution_simulation f e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es \<Longrightarrow>
          execution_simulation f e1 s1 r1 e2 s2 r2 ((l, i)#es)"
 text_raw\<open>}%endsnip\<close>
 
 definition "execution_simulates e1 e2 = (\<exists>f. \<forall>t. execution_simulation f e1 0 <> e2 0 <> t)"
 
 lemma execution_simulation_step:
 "execution_simulation f e1 s1 r1 e2 s2 r2 ((l, i)#es) =
  (s2 = f s1 \<and>
  (\<forall>(s1', t1) |\<in>| (possible_steps e1 s1 r1 l i).
          (\<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i. evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
          execution_simulation f e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es))
 )"
   apply standard
    apply (rule execution_simulation.cases)
      apply simp
     apply simp
    apply simp
   apply (rule execution_simulation.step)
    apply simp
   by blast
 
 text_raw\<open>\snip{execTraceSim}{1}{2}{%\<close>
 lemma execution_simulation_trace_simulation:
   "execution_simulation f e1 s1 r1 e2 s2 r2 (map (\<lambda>(l, i, o). (l, i)) t) \<Longrightarrow>
    trace_simulation f e1 s1 r1 e2 s2 r2 t"
 text_raw\<open>}%endsnip\<close>
 proof(induct t arbitrary: s1 s2 r1 r2)
 case Nil
   then show ?case
     apply (rule execution_simulation.cases)
      apply (simp add: trace_simulation.base)
     by simp
 next
   case (Cons a t)
   then show ?case
     apply (cases a, clarsimp)
     apply (rule execution_simulation.cases)
       apply simp
      apply simp
     apply (rule trace_simulation.step)
      apply simp
     apply clarsimp
     subgoal for _ _ _ aa ba
       apply (erule_tac x="(aa, ba)" in fBallE)
        apply clarsimp
        apply blast
       by simp
     done
 qed
 
 lemma execution_simulates_trace_simulates:
   "execution_simulates e1 e2 \<Longrightarrow> trace_simulates e1 e2"
   apply (simp add: execution_simulates_def trace_simulates_def)
   using execution_simulation_trace_simulation by blast
 
 subsubsection\<open>Executional Equivalence\<close>
 text\<open>Two EFSMs are executionally equivalent if there is no execution which can distinguish between
 the two. That is, for every execution, they must produce equivalent outputs.\<close>
 
 text_raw\<open>\snip{execEquiv}{1}{2}{%\<close>
 inductive executionally_equivalent :: "transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow>
 transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   base [simp]: "executionally_equivalent e1 s1 r1 e2 s2 r2 []" |
   step: "\<forall>(s1', t1) |\<in>| possible_steps e1 s1 r1 l i.
            \<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i.
              evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
              executionally_equivalent e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es \<Longrightarrow>
          \<forall>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i.
            \<exists>(s1', t1) |\<in>| possible_steps e1 s1 r1 l i.
              evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
              executionally_equivalent e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es \<Longrightarrow>
          executionally_equivalent e1 s1 r1 e2 s2 r2 ((l, i)#es)"
 text_raw\<open>}%endsnip\<close>
 
 lemma executionally_equivalent_step:
 "executionally_equivalent e1 s1 r1 e2 s2 r2 ((l, i)#es) = (
   (\<forall>(s1', t1) |\<in>| (possible_steps e1 s1 r1 l i). (\<exists>(s2', t2) |\<in>| possible_steps e2 s2 r2 l i. evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
    executionally_equivalent e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es)) \<and>
   (\<forall>(s2', t2) |\<in>| (possible_steps e2 s2 r2 l i). (\<exists>(s1', t1) |\<in>| possible_steps e1 s1 r1 l i. evaluate_outputs t1 i r1 = evaluate_outputs t2 i r2 \<and>
    executionally_equivalent e1 s1' (evaluate_updates t1 i r1) e2 s2' (evaluate_updates t2 i r2) es)))"
   apply standard
    apply (rule executionally_equivalent.cases)
      apply simp
     apply simp
    apply simp
   by (rule executionally_equivalent.step, auto)
 
 lemma execution_end:
   "possible_steps e1 s1 r1 l i = {||} \<Longrightarrow>
    possible_steps e2 s2 r2 l i = {||} \<Longrightarrow>
   executionally_equivalent e1 s1 r1 e2 s2 r2 ((l, i)#es)"
   by (simp add: executionally_equivalent_step)
 
 lemma possible_steps_disparity:
   "possible_steps e1 s1 r1 l i \<noteq> {||} \<Longrightarrow>
    possible_steps e2 s2 r2 l i = {||} \<Longrightarrow>
    \<not>executionally_equivalent e1 s1 r1 e2 s2 r2 ((l, i)#es)"
   by (simp add: executionally_equivalent_step, auto)
 
 lemma executionally_equivalent_acceptance_map:
   "executionally_equivalent e1 s1 r1 e2 s2 r2 (map (\<lambda>(l, i, o). (l, i)) t) \<Longrightarrow>
    accepts_trace e2 s2 r2 t = accepts_trace e1 s1 r1 t"
 proof(induct t arbitrary: s1 s2 r1 r2)
   case (Cons a t)
   then show ?case
     apply (cases a, simp)
     apply (rule executionally_equivalent.cases)
       apply simp
      apply simp
     apply clarsimp
     apply standard
     subgoal for i p l
       apply (rule accepts_trace.cases)
         apply simp
        apply simp
       apply clarsimp
       subgoal for aa b
         apply (rule accepts_trace.step)
         apply (erule_tac x="(aa, b)" in fBallE[of "possible_steps e2 s2 r2 l i"])
          defer apply simp
         apply simp
         by blast
       done
     apply (rule accepts_trace.cases)
       apply simp
      apply simp
     apply clarsimp
     subgoal for _ _ _ aa b
       apply (rule accepts_trace.step)
       apply (erule_tac x="(aa, b)" in fBallE)
        defer apply simp
       apply simp
       by fastforce
     done
 qed auto
 
 lemma executionally_equivalent_acceptance:
   "\<forall>x. executionally_equivalent e1 s1 r1 e2 s2 r2 x \<Longrightarrow> accepts_trace e1 s1 r1  t \<Longrightarrow> accepts_trace e2 s2 r2 t"
   using executionally_equivalent_acceptance_map by blast
 
 lemma executionally_equivalent_trace_equivalent:
   "\<forall>x. executionally_equivalent e1 0 <> e2 0 <> x \<Longrightarrow> trace_equivalent e1 e2"
   apply (rule trace_equivalent)
   apply clarify
   subgoal for t apply (erule_tac x="map (\<lambda>(l, i, o). (l, i)) t" in allE)
     by (simp add: executionally_equivalent_acceptance_map)
   done
 
 lemma executionally_equivalent_symmetry:
   "executionally_equivalent e1 s1 r1 e2 s2 r2 x \<Longrightarrow>
    executionally_equivalent e2 s2 r2 e1 s1 r1 x"
 proof(induct x arbitrary: s1 s2 r1 r2)
   case (Cons a x)
   then show ?case
     apply (cases a, clarsimp)
     apply (simp add: executionally_equivalent_step)
     apply standard
      apply (rule fBallI)
      apply clarsimp
     subgoal for aa b aaa ba
       apply (erule_tac x="(aaa, ba)" in fBallE[of "possible_steps e2 s2 r2 aa b"])
       by (force, simp)
     apply (rule fBallI)
     apply clarsimp
     subgoal for aa b aaa ba
       apply (erule_tac x="(aaa, ba)" in fBallE)
       by (force, simp)
     done
 qed auto
 
 lemma executionally_equivalent_transitivity:
   "executionally_equivalent e1 s1 r1 e2 s2 r2 x \<Longrightarrow>
    executionally_equivalent e2 s2 r2 e3 s3 r3 x \<Longrightarrow>
    executionally_equivalent e1 s1 r1 e3 s3 r3 x"
 proof(induct x arbitrary: s1 s2 s3 r1 r2 r3)
   case (Cons a x)
   then show ?case
     apply (cases a, clarsimp)
     apply (simp add: executionally_equivalent_step)
     apply clarsimp
     apply standard
      apply (rule fBallI)
      apply clarsimp
     subgoal for aa b ab ba
       apply (erule_tac x="(ab, ba)" in fBallE[of "possible_steps e1 s1 r1 aa b"])
        prefer 2 apply simp
       apply simp
       apply (erule fBexE)
       subgoal for x apply (case_tac x)
         apply simp
         by blast
       done
     apply (rule fBallI)
     apply clarsimp
     subgoal for aa b ab ba
       apply (erule_tac x="(ab, ba)" in fBallE[of "possible_steps e3 s3 r3 aa b"])
        prefer 2 apply simp
       apply simp
       apply (erule fBexE)
       subgoal for x apply (case_tac x)
         apply clarsimp
         subgoal for aaa baa
           apply (erule_tac x="(aaa, baa)" in fBallE[of "possible_steps e2 s2 r2 aa b"])
            prefer 2 apply simp
           apply simp
           by blast
         done
       done
     done
 qed auto
 
 subsection\<open>Reachability\<close>
 text\<open>Here, we define the function \texttt{visits} which returns true if the given execution
 leaves the given EFSM in the given state.\<close>
 
 text_raw\<open>\snip{reachable}{1}{2}{%\<close>
 inductive visits :: "cfstate \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   base [simp]: "visits s e s r []" |
   step: "\<exists>(s', T) |\<in>| possible_steps e s r l i. visits target e s' (evaluate_updates T i r) t \<Longrightarrow>
          visits target e s r ((l, i)#t)"
 
 definition "reachable s e = (\<exists>t. visits s e 0 <> t)"
 text_raw\<open>}%endsnip\<close>
 
 lemma no_further_steps:
   "s \<noteq> s' \<Longrightarrow> \<not> visits s e s' r []"
   apply safe
   apply (rule visits.cases)
   by auto
 
 lemma visits_base: "visits target e s r [] = (s = target)"
   by (metis visits.base no_further_steps)
 
 lemma visits_step:
   "visits target e s r (h#t) = (\<exists>(s', T) |\<in>| possible_steps e s r (fst h) (snd h). visits target e s' (evaluate_updates T (snd h) r) t)"
   apply standard
    apply (rule visits.cases)
      apply simp+
   apply (cases h)
   using visits.step by auto
 
 lemma reachable_initial: "reachable 0 e"
   apply (simp add: reachable_def)
   apply (rule_tac x="[]" in exI)
   by simp
 
 lemma visits_finsert:
   "visits s e s' r t \<Longrightarrow> visits s (finsert ((aa, ba), b) e) s' r t"
 proof(induct t arbitrary: s' r)
   case Nil
   then show ?case
     by (simp add: visits_base)
 next
   case (Cons a t)
   then show ?case
     apply (simp add: visits_step)
     apply (erule fBexE)
     apply (rule_tac x=x in fBexI)
      apply auto[1]
     by (simp add: possible_steps_finsert)
 qed
 
 lemma reachable_finsert:
   "reachable s e \<Longrightarrow> reachable s (finsert ((aa, ba), b) e)"
   apply (simp add: reachable_def)
   by (meson visits_finsert)
 
 lemma reachable_finsert_contra:
   "\<not> reachable s (finsert ((aa, ba), b) e) \<Longrightarrow> \<not>reachable s e"
   using reachable_finsert by blast
 
 lemma visits_empty: "visits s e s' r [] = (s = s')"
   apply standard
   by (rule visits.cases, auto)
 
 definition "remove_state s e = ffilter (\<lambda>((from, to), t). from \<noteq> s \<and> to \<noteq> s) e"
 
 text_raw\<open>\snip{obtainable}{1}{2}{%\<close>
 inductive "obtains" :: "cfstate \<Rightarrow> registers \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> registers \<Rightarrow> execution \<Rightarrow> bool" where
   base [simp]: "obtains s r e s r []" |
   step: "\<exists>(s'', T) |\<in>| possible_steps e s' r' l i. obtains s r e s'' (evaluate_updates T i r') t \<Longrightarrow>
          obtains s r e s' r' ((l, i)#t)"
 
 definition "obtainable s r e = (\<exists>t. obtains s r e 0 <> t)"
 text_raw\<open>}%endsnip\<close>
 
 lemma obtains_obtainable:
   "obtains s r e 0 <> t \<Longrightarrow> obtainable s r e"
   apply (simp add: obtainable_def)
   by auto
 
 lemma obtains_base: "obtains s r e s' r' [] = (s = s' \<and> r = r')"
   apply standard
   by (rule obtains.cases, auto)
 
 lemma obtains_step: "obtains s r e s' r' ((l, i)#t) = (\<exists>(s'', T) |\<in>| possible_steps e s' r' l i. obtains s r e s'' (evaluate_updates T i r') t)"
   apply standard
   by (rule obtains.cases, auto simp add: obtains.step)
 
 lemma obtains_recognises:
   "obtains s c e s' r t \<Longrightarrow> recognises_execution e s' r t"
 proof(induct t arbitrary: s' r)
   case Nil
   then show ?case
     by (simp add: obtains_base)
 next
   case (Cons a t)
   then show ?case
     apply (cases a)
     apply simp
     apply (rule obtains.cases)
       apply simp
      apply simp
     apply clarsimp
     using recognises_execution.step by fastforce
 qed
 
 lemma ex_comm4:
   "(\<exists>c1 s a b. (a, b) \<in> fset (possible_steps e s' r l i) \<and> obtains s c1 e a (evaluate_updates b i r) t) =
    (\<exists>a b s c1. (a, b) \<in> fset (possible_steps e s' r l i) \<and> obtains s c1 e a (evaluate_updates b i r) t)"
   by auto
 
 lemma recognises_execution_obtains:
   "recognises_execution e s' r t \<Longrightarrow> \<exists>c1 s. obtains s c1 e s' r t"
 proof(induct t arbitrary: s' r)
   case Nil
   then show ?case
     by (simp add: obtains_base)
 next
   case (Cons a t)
   then show ?case
     apply (cases a)
     apply (simp add: obtains_step)
     apply (rule recognises_execution.cases)
       apply simp
      apply simp
     apply clarsimp
-    apply (simp add: fBex_def Bex_def ex_comm4)
+    apply (simp add: Bex_def ex_comm4)
     subgoal for _ _ aa ba
       apply (rule_tac x=aa in exI)
       apply (rule_tac x=ba in exI)
       apply simp
       by blast
     done  
 qed
 
 lemma obtainable_empty_efsm:
   "obtainable s c {||} = (s=0 \<and> c = <>)"
   apply (simp add: obtainable_def)
   apply standard
   apply (metis ffilter_empty no_outgoing_transitions no_step_none obtains.cases obtains_recognises step_None)
   using obtains_base by blast
 
 lemma obtains_visits: "obtains s r e s' r' t \<Longrightarrow> visits s e s' r' t"
 proof(induct t arbitrary: s' r')
   case Nil
   then show ?case
     by (simp add: obtains_base)
 next
   case (Cons a t)
   then show ?case
     apply (cases a)
     apply (rule obtains.cases)
       apply simp
      apply simp
     apply clarsimp
     apply (rule visits.step)
     by auto
 qed
 
 lemma unobtainable_if: "\<not> visits s e s' r' t \<Longrightarrow> \<not> obtains s r e s' r' t"
   using obtains_visits by blast
 
 lemma obtainable_if_unreachable: "\<not>reachable s e \<Longrightarrow> \<not>obtainable s r e"
   by (simp add: reachable_def obtainable_def unobtainable_if)
 
 lemma obtains_step_append:
   "obtains s r e s' r' t \<Longrightarrow>
   (s'', ta) |\<in>| possible_steps e s r l i \<Longrightarrow>
   obtains s'' (evaluate_updates ta i r) e s' r' (t @ [(l, i)])"
 proof(induct t arbitrary: s' r')
   case Nil
   then show ?case
     apply (simp add: obtains_base)
     apply (rule obtains.step)
     apply (rule_tac x="(s'', ta)" in fBexI)
     by auto
 next
   case (Cons a t)
   then show ?case
     apply simp
     apply (rule obtains.cases)
       apply simp
      apply simp
     apply clarsimp
     apply (rule obtains.step)
     by auto
 qed
 
 lemma reachable_if_obtainable_step:
   "obtainable s r e \<Longrightarrow> \<exists>l i t. (s', t) |\<in>| possible_steps e s r l i \<Longrightarrow> reachable s' e"
   apply (simp add: reachable_def obtainable_def)
   apply clarify
   subgoal for t l i
     apply (rule_tac x="t@[(l, i)]" in exI)
     using obtains_step_append unobtainable_if by blast
   done
 
 lemma possible_steps_remove_unreachable:
   "obtainable s r e \<Longrightarrow>
   \<not> reachable s' e \<Longrightarrow>
   possible_steps (remove_state s' e) s r l i = possible_steps e s r l i"
   apply standard
   apply (simp add: fsubset_eq)
    apply (rule fBallI)
    apply clarsimp
    apply (metis ffmember_filter in_possible_steps remove_state_def)
   apply (simp add: fsubset_eq)
    apply (rule fBallI)
   apply clarsimp
   subgoal for a b
     apply (case_tac "a = s'")
     using reachable_if_obtainable_step apply blast
     apply (simp add: remove_state_def)
     by (metis (mono_tags, lifting) ffmember_filter in_possible_steps obtainable_if_unreachable old.prod.case)
   done
 
 text_raw\<open>\snip{removeUnreachableArb}{1}{2}{%\<close>
 lemma executionally_equivalent_remove_unreachable_state_arbitrary:
   "obtainable s r e \<Longrightarrow> \<not> reachable s' e \<Longrightarrow> executionally_equivalent e s r (remove_state s' e) s r x"
 text_raw\<open>}%endsnip\<close>
 proof(induct x arbitrary: s r)
   case (Cons a x)
   then show ?case
     apply (cases a, simp)
     apply (rule executionally_equivalent.step)
     apply (simp add: possible_steps_remove_unreachable)
     apply standard
      apply clarsimp
     subgoal for aa b ab ba
       apply (rule_tac x="(ab, ba)" in fBexI)
        apply (metis (mono_tags, lifting) obtainable_def obtains_step_append case_prodI)
       apply simp
       done
     apply (rule fBallI)
     apply clarsimp
     apply (rule_tac x="(ab, ba)" in fBexI)
      apply simp
      apply (metis obtainable_def obtains_step_append possible_steps_remove_unreachable)
     by (simp add: possible_steps_remove_unreachable)
 qed auto
 
 text_raw\<open>\snip{removeUnreachable}{1}{2}{%\<close>
 lemma executionally_equivalent_remove_unreachable_state:
   "\<not> reachable s' e \<Longrightarrow> executionally_equivalent e 0 <> (remove_state s' e) 0 <> x"
 text_raw\<open>}%endsnip\<close>
   by (meson executionally_equivalent_remove_unreachable_state_arbitrary
       obtains.simps obtains_obtainable)
 
 subsection\<open>Transition Replacement\<close>
 text\<open>Here, we define the function \texttt{replace} to replace one transition with another, and prove
 some of its properties.\<close>
 
 definition "replace e1 old new = fimage (\<lambda>x. if x = old then new else x) e1"
 
 lemma replace_finsert:
   "replace (finsert ((aaa, baa), b) e1) old new = (if ((aaa, baa), b) = old then (finsert new (replace e1 old new)) else (finsert ((aaa, baa), b) (replace e1 old new)))"
   by (simp add: replace_def)
 
 lemma possible_steps_replace_unchanged:
   "((s, aa), ba) \<noteq> ((s1, s2), t1) \<Longrightarrow>
   (aa, ba) |\<in>| possible_steps e1 s r l i \<Longrightarrow>
   (aa, ba) |\<in>| possible_steps (replace e1 ((s1, s2), t1) ((s1, s2), t2)) s r l i"
   by (simp add: in_possible_steps[symmetric] replace_def)
 
 end
diff --git a/thys/Extended_Finite_State_Machines/EFSM_LTL.thy b/thys/Extended_Finite_State_Machines/EFSM_LTL.thy
--- a/thys/Extended_Finite_State_Machines/EFSM_LTL.thy
+++ b/thys/Extended_Finite_State_Machines/EFSM_LTL.thy
@@ -1,281 +1,281 @@
 section\<open>LTL for EFSMs\<close>
 text\<open>This theory builds off the \texttt{Linear\_Temporal\_Logic\_on\_Streams} theory from the HOL
 library and defines functions to ease the expression of LTL properties over EFSMs. Since the LTL
 operators effectively act over traces of models we must find a way to express models as streams.\<close>
 
 theory EFSM_LTL
 imports "Extended_Finite_State_Machines.EFSM" "HOL-Library.Linear_Temporal_Logic_on_Streams"
 begin
 
 text_raw\<open>\snip{statedef}{1}{2}{%\<close>
 record state =
   statename :: "nat option"
   datastate :: registers
   action :: action
   "output" :: outputs
 text_raw\<open>}%endsnip\<close>
 
 text_raw\<open>\snip{whitebox}{1}{2}{%\<close>
 type_synonym whitebox_trace = "state stream"
 text_raw\<open>}%endsnip\<close>
 
 type_synonym property = "whitebox_trace \<Rightarrow> bool"
 
 abbreviation label :: "state \<Rightarrow> String.literal" where
   "label s \<equiv> fst (action s)"
 
 abbreviation inputs :: "state \<Rightarrow> value list" where
   "inputs s \<equiv> snd (action s)"
 
 text_raw\<open>\snip{ltlStep}{1}{2}{%\<close>
 fun ltl_step :: "transition_matrix \<Rightarrow> cfstate option \<Rightarrow> registers \<Rightarrow> action \<Rightarrow> (nat option \<times> outputs \<times> registers)" where
   "ltl_step _ None r _ = (None, [], r)" |
   "ltl_step e (Some s) r (l, i) = (let possibilities = possible_steps e s r l i in
                    if possibilities = {||} then (None, [], r)
                    else
                      let (s', t) = Eps (\<lambda>x. x |\<in>| possibilities) in
                      (Some s', (evaluate_outputs t i r), (evaluate_updates t i r))
                   )"
 text_raw\<open>}%endsnip\<close>
 
 lemma ltl_step_singleton:
 "\<exists>t. possible_steps e n r (fst v) (snd v) = {|(aa, t)|} \<and> evaluate_outputs t (snd v) r  = b \<and> evaluate_updates t (snd v) r = c\<Longrightarrow>
 ltl_step e (Some n) r v = (Some aa, b, c)"
   apply (cases v)
   by auto
 
 lemma ltl_step_none: "possible_steps e s r a b = {||} \<Longrightarrow> ltl_step e (Some s) r (a, b) = (None, [], r)"
   by simp
 
 lemma ltl_step_none_2: "possible_steps e s r (fst ie) (snd ie) = {||} \<Longrightarrow> ltl_step e (Some s) r ie = (None, [], r)"
   by (metis ltl_step_none prod.exhaust_sel)
 
 lemma ltl_step_alt: "ltl_step e (Some s) r t = (
   let possibilities = possible_steps e s r (fst t) (snd t) in
   if possibilities = {||} then
     (None, [], r)
   else
   let (s', t') = Eps (\<lambda>x. x |\<in>| possibilities) in
   (Some s', (apply_outputs (Outputs t') (join_ir (snd t) r)), (apply_updates (Updates t') (join_ir (snd t) r) r))
 )"
   by (case_tac t, simp add: Let_def)
 
 lemma ltl_step_some:
   assumes "possible_steps e s r l i = {|(s', t)|}"
       and "evaluate_outputs t i r = p"
       and "evaluate_updates t i r = r'"
     shows "ltl_step e (Some s) r (l, i) = (Some s', p, r')"
   by (simp add: assms)
 
 lemma ltl_step_cases:
   assumes invalid: "P (None, [], r)"
       and valid: "\<forall>(s', t) |\<in>| (possible_steps e s r l i). P (Some s', (evaluate_outputs t i r), (evaluate_updates t i r))"
     shows "P (ltl_step e (Some s) r (l, i))"
   apply simp
   apply (case_tac "possible_steps e s r l i")
    apply (simp add: invalid)
   apply simp
   subgoal for x S'
     apply (case_tac "SOME xa. xa = x \<or> xa |\<in>| S'")
     apply simp
     apply (insert assms(2))
-    apply (simp add: fBall_def Ball_def)
+    apply (simp add: Ball_def)
     by (metis (mono_tags, lifting) fst_conv prod.case_eq_if snd_conv someI_ex)
   done
 
 text\<open>The \texttt{make\_full\_observation} function behaves similarly to \texttt{observe\_execution}
 from the \texttt{EFSM} theory. The main difference in behaviour is what is recorded. While the
 observe execution function simply observes an execution of the EFSM to produce the corresponding
 output for each action, the intention here is to record every detail of execution, including the
 values of internal variables.
 
 Thinking of each action as a step forward in time, there are five components which characterise
 a given point in the execution of an EFSM. At each point, the model has a current control state and
 data state. Each action has a label and some input parameters, and its execution may produce
 some observableoutput. It is therefore sufficient to provide a stream of 5-tuples containing the
 current control state, data state, the label and inputs of the action, and computed output. The
 make full observation function can then be defined as in Figure 9.1, with an additional
 function watch defined on top of this which starts the make full observation off in the
 initial control state with the empty data state.
 
 Careful inspection of the definition reveals another way that \texttt{make\_full\_observation}
 differs from \texttt{observe\_execution}. Rather than taking a cfstate, it takes a cfstate option.
 The reason for this is that we need to make our EFSM models complete. That is, we need them to be
 able to respond to every action from every state like a DFA. If a model does not recognise a given
 action in a given state, we cannot simply stop processing because we are working with necessarily
 infinite traces. Since these traces are generated by observing action sequences, the make full
 observation function must keep processing whether there is a viable transition or not.
 
 To support this, the make full observation adds an implicit ``sink state'' to every EFSM it
 processes by lifting control flow state indices from \texttt{nat} to \texttt{nat option} such that
 state $n$ is seen as state \texttt{Some} $n$. The control flow state \texttt{None} represents a sink
 state. If a model is unable to recognise a particular action from its current state, it moves into
 the \texttt{None} state. From here, the behaviour is constant for the rest of the time --- the
 control flow state remains None; the data state does not change, and no output is produced.\<close>
 
 text_raw\<open>\snip{makeFullObservation}{1}{2}{%\<close>
 primcorec make_full_observation :: "transition_matrix \<Rightarrow> cfstate option \<Rightarrow> registers \<Rightarrow> outputs \<Rightarrow> action stream \<Rightarrow> whitebox_trace" where
   "make_full_observation e s d p i = (
     let (s', o', d') = ltl_step e s d (shd i) in
     \<lparr>statename = s, datastate = d, action=(shd i), output = p\<rparr>##(make_full_observation e s' d' o' (stl i))
   )"
 text_raw\<open>}%endsnip\<close>
 
 text_raw\<open>\snip{watch}{1}{2}{%\<close>
 abbreviation watch :: "transition_matrix \<Rightarrow> action stream \<Rightarrow> whitebox_trace" where
   "watch e i \<equiv> (make_full_observation e (Some 0) <> [] i)"
 text_raw\<open>}%endsnip\<close>
 
 subsection\<open>Expressing Properties\<close>
 text\<open>In order to simplify the expression and understanding of properties, this theory defines a
 number of named functions which can be used to express certain properties of EFSMs.\<close>
 
 subsubsection\<open>State Equality\<close>
 text\<open>The \textsc{state\_eq} takes a cfstate option representing a control flow state index and
 returns true if this is the control flow state at the head of the full observation.\<close>
 
 abbreviation state_eq :: "cfstate option \<Rightarrow> whitebox_trace \<Rightarrow> bool" where
   "state_eq v s \<equiv> statename (shd s) = v"
 
 lemma state_eq_holds: "state_eq s = holds (\<lambda>x. statename x = s)"
   apply (rule ext)
   by (simp add: holds_def)
 
 lemma state_eq_None_not_Some: "state_eq None s \<Longrightarrow> \<not> state_eq (Some n) s"
   by simp
 
 subsubsection\<open>Label Equality\<close>
 text\<open>The \textsc{label\_eq} function takes a string and returns true if this is equal to the label
 at the head of the full observation.\<close>
 
 abbreviation "label_eq v s \<equiv> fst (action (shd s)) = (String.implode v)"
 
 lemma watch_label: "label_eq l (watch e t) = (fst (shd t) = String.implode l)"
   by simp
 
 subsubsection\<open>Input Equality\<close>
 text\<open>The \textsc{input\_eq} function takes a value list and returns true if this is equal to the
 input at the head of the full observation.\<close>
 
 abbreviation "input_eq v s \<equiv> inputs (shd s) = v"
 
 subsubsection\<open>Action Equality\<close>
 text\<open>The \textsc{action\_eq} function takes a (label, value list) pair and returns true if this is
 equal to the action at the head of the full observation. This effectively combines
 \texttt{label\_eq} and \texttt{input\_eq} into one function.\<close>
 
 abbreviation "action_eq e \<equiv> label_eq (fst e) aand input_eq (snd e)"
 
 subsubsection\<open>Output Equality\<close>
 text\<open>The \textsc{output\_eq} function takes a takes a value option list and returns true if this is
 equal to the output at the head of the full observation.\<close>
 
 abbreviation "output_eq v s \<equiv> output (shd s) = v"
 
 text_raw\<open>\snip{ltlVName}{1}{2}{%\<close>
 datatype ltl_vname = Ip nat | Op nat | Rg nat
 text_raw\<open>}%endsnip\<close>
 
 subsubsection\<open>Checking Arbitrary Expressions\<close>
 text\<open>The \textsc{check\_exp} function takes a guard expression and returns true if the guard
 expression evaluates to true in the given state.\<close>
 
 type_synonym ltl_gexp = "ltl_vname gexp"
 
 definition join_iro :: "value list \<Rightarrow> registers \<Rightarrow> outputs \<Rightarrow> ltl_vname datastate" where
   "join_iro i r p = (\<lambda>x. case x of
     Rg n \<Rightarrow> r $ n |
     Ip n \<Rightarrow> Some (i ! n) |
     Op n \<Rightarrow> p ! n
   )"
 
 lemma join_iro_R [simp]: "join_iro i r p (Rg n) = r $ n"
   by (simp add: join_iro_def)
 
 abbreviation "check_exp g s \<equiv> (gval g (join_iro (snd (action (shd s))) (datastate (shd s)) (output (shd s))) = trilean.true)"
 
 lemma alw_ev: "alw f = not (ev (\<lambda>s. \<not>f s))"
   by simp
 
 lemma alw_state_eq_smap:
   "alw (state_eq s) ss = alw (\<lambda>ss. shd ss = s) (smap statename ss)"
   apply standard
    apply (simp add: alw_iff_sdrop )
   by (simp add: alw_mono alw_smap )
 
 subsection\<open>Sink State\<close>
 text\<open>Once the sink state is entered, it cannot be left and there are no outputs or updates
 henceforth.\<close>
 
 lemma shd_state_is_none: "(state_eq None) (make_full_observation e None r p t)"
   by simp
 
 lemma unfold_observe_none: "make_full_observation e None d p t = (\<lparr>statename = None, datastate = d, action=(shd t), output = p\<rparr>##(make_full_observation e None d [] (stl t)))"
   by (simp add: stream.expand)
 
 lemma once_none_always_none_aux:
   assumes "\<exists> p r i. j = (make_full_observation e None r p) i"
   shows "alw (state_eq None) j"
   using assms apply coinduct
   apply simp
   by fastforce
 
 lemma once_none_always_none: "alw (state_eq None) (make_full_observation e None r p t)"
   using once_none_always_none_aux by blast
 
 lemma once_none_nxt_always_none: "alw (nxt (state_eq None)) (make_full_observation e None r p t)"
   using once_none_always_none
   by (simp add: alw_iff_sdrop del: sdrop.simps)
 
 lemma snth_sconst: "(\<forall>i. s !! i = h) = (s = sconst h)"
   by (auto simp add: sconst_alt sset_range)
 
 lemma alw_sconst: "(alw (\<lambda>xs. shd xs = h) t) = (t = sconst h)"
   by (simp add: snth_sconst[symmetric] alw_iff_sdrop)
 
 lemma smap_statename_None: "smap statename (make_full_observation e None r p i) = sconst None"
   by (meson EFSM_LTL.alw_sconst alw_state_eq_smap once_none_always_none)
 
 lemma alw_not_some: "alw (\<lambda>xs. statename (shd xs) \<noteq> Some s) (make_full_observation e None r p t)"
   by (metis (mono_tags, lifting) alw_mono once_none_always_none option.distinct(1) )
 
 lemma state_none: "((state_eq None) impl nxt (state_eq None)) (make_full_observation e s r p t)"
   by simp
 
 lemma state_none_2:
   "(state_eq None) (make_full_observation e s r p t) \<Longrightarrow>
    (state_eq None) (make_full_observation e s r p (stl t))"
   by simp
 
 lemma no_output_none_aux:
   assumes "\<exists> p r i. j = (make_full_observation e None r []) i"
   shows "alw (output_eq []) j"
   using assms apply coinduct
   apply simp
   by fastforce
 
 lemma no_output_none: "nxt (alw (output_eq [])) (make_full_observation e None r p t)"
   using no_output_none_aux by auto
 
 lemma nxt_alw: "nxt (alw P) s \<Longrightarrow> alw (nxt P) s"
   by (simp add: alw_iff_sdrop)
 
 lemma no_output_none_nxt: "alw (nxt (output_eq [])) (make_full_observation e None r p t)"
   using nxt_alw no_output_none by blast
 
 lemma no_output_none_if_empty: "alw (output_eq []) (make_full_observation e None r [] t)"
   by (metis (mono_tags, lifting) alw_nxt make_full_observation.simps(1) no_output_none state.select_convs(4))
 
 lemma no_updates_none_aux:
   assumes "\<exists> p i. j = (make_full_observation e None r p) i"
   shows "alw (\<lambda>x. datastate (shd x) = r) j"
   using assms apply coinduct
   by fastforce
 
 lemma no_updates_none: "alw (\<lambda>x. datastate (shd x) = r) (make_full_observation e None r p t)"
   using no_updates_none_aux by blast
 
 lemma action_components: "(label_eq l aand input_eq i) s = (action (shd s) = (String.implode l, i))"
   by (metis fst_conv prod.collapse snd_conv)
 
 end
diff --git a/thys/FO_Theory_Rewriting/FOL_Extra.thy b/thys/FO_Theory_Rewriting/FOL_Extra.thy
--- a/thys/FO_Theory_Rewriting/FOL_Extra.thy
+++ b/thys/FO_Theory_Rewriting/FOL_Extra.thy
@@ -1,405 +1,405 @@
 theory FOL_Extra
   imports
     Type_Instances_Impl
     "FOL-Fitting.FOL_Fitting"
     "HOL-Library.FSet"
 begin
 
 section \<open>Additional support for FOL-Fitting\<close>
 subsection \<open>Iff\<close>
 
 definition Iff where
   "Iff p q = And (Impl p q) (Impl q p)"
 
 lemma eval_Iff:
   "eval e f g (Iff p q) \<longleftrightarrow> (eval e f g p \<longleftrightarrow> eval e f g q)"
   by (auto simp: Iff_def)
 
 
 subsection \<open>Replacement of subformulas\<close>
 
 datatype ('a, 'b) ctxt
   = Hole
   | And1 "('a, 'b) ctxt" "('a, 'b) form"
   | And2 "('a, 'b) form" "('a, 'b) ctxt"
   | Or1 "('a, 'b) ctxt" "('a, 'b) form"
   | Or2 "('a, 'b) form" "('a, 'b) ctxt"
   | Impl1 "('a, 'b) ctxt" "('a, 'b) form"
   | Impl2 "('a, 'b) form" "('a, 'b) ctxt"
   | Neg1 "('a, 'b) ctxt"
   | Forall1 "('a, 'b) ctxt"
   | Exists1 "('a, 'b) ctxt"
 
 primrec apply_ctxt :: "('a, 'b) ctxt \<Rightarrow> ('a, 'b) form \<Rightarrow> ('a, 'b) form" where
   "apply_ctxt Hole p = p"
 | "apply_ctxt (And1 c v) p = And (apply_ctxt c p) v"
 | "apply_ctxt (And2 u c) p = And u (apply_ctxt c p)"
 | "apply_ctxt (Or1 c v) p = Or (apply_ctxt c p) v"
 | "apply_ctxt (Or2 u c) p = Or u (apply_ctxt c p)"
 | "apply_ctxt (Impl1 c v) p = Impl (apply_ctxt c p) v"
 | "apply_ctxt (Impl2 u c) p = Impl u (apply_ctxt c p)"
 | "apply_ctxt (Neg1 c) p = Neg (apply_ctxt c p)"
 | "apply_ctxt (Forall1 c) p = Forall (apply_ctxt c p)"
 | "apply_ctxt (Exists1 c) p = Exists (apply_ctxt c p)"
 
 lemma replace_subformula:
   assumes "\<And>e. eval e f g (Iff p q)"
   shows "eval e f g (Iff (apply_ctxt c p) (apply_ctxt c q))"
   by (induct c arbitrary: e) (auto simp: assms[unfolded eval_Iff] Iff_def)
 
 
 subsection \<open>Propositional identities\<close>
 
 lemma prop_ids:
   "eval e f g (Iff (And p q) (And q p))"
   "eval e f g (Iff (Or p q) (Or q p))"
   "eval e f g (Iff (Or p (Or q r)) (Or (Or p q) r))"
   "eval e f g (Iff (And p (And q r)) (And (And p q) r))"
   "eval e f g (Iff (Neg (Or p q)) (And (Neg p) (Neg q)))"
   "eval e f g (Iff (Neg (And p q)) (Or (Neg p) (Neg q)))"
   (* ... *)
   by (auto simp: Iff_def)
 
 
 subsection \<open>de Bruijn index manipulation for formulas; cf. @{term liftt}\<close>
 
 primrec liftti :: "nat \<Rightarrow> 'a term \<Rightarrow> 'a term" where
   "liftti i (Var j) = (if i > j then Var j else Var (Suc j))"
 | "liftti i (App f ts) = App f (map (liftti i) ts)"
 
 lemma liftts_def':
   "liftts ts = map liftt ts"
   by (induct ts) auto
 
 text \<open>@{term liftt} is a special case of @{term liftti}\<close>
 lemma lifttti_0:
   "liftti 0 t = liftt t"
   by (induct t) (auto simp: liftts_def')
 
 primrec lifti :: "nat \<Rightarrow> ('a, 'b) form \<Rightarrow> ('a, 'b) form" where
   "lifti i FF = FF"
 | "lifti i TT = TT"
 | "lifti i (Pred b ts) = Pred b (map (liftti i) ts)"
 | "lifti i (And p q) = And (lifti i p) (lifti i q)"
 | "lifti i (Or p q) = Or (lifti i p) (lifti i q)"
 | "lifti i (Impl p q) = Impl (lifti i p) (lifti i q)"
 | "lifti i (Neg p) = Neg (lifti i p)"
 | "lifti i (Forall p) = Forall (lifti (Suc i) p)"
 | "lifti i (Exists p) = Exists (lifti (Suc i) p)"
 
 abbreviation lift where
   "lift \<equiv> lifti 0"
 
 text \<open>interaction of @{term lifti} and @{term eval}\<close>
 
 lemma evalts_def':
   "evalts e f ts = map (evalt e f) ts"
   by (induct ts) auto
 
 lemma evalt_liftti:
   "evalt (e\<langle>i:z\<rangle>) f (liftti i t) = evalt e f t"
   by (induct t) (auto simp: evalts_def' cong: map_cong)
 
 lemma eval_lifti [simp]:
   "eval (e\<langle>i:z\<rangle>) f g (lifti i p) = eval e f g p"
   by (induct p arbitrary: e i) (auto simp: evalt_liftti evalts_def' comp_def)
 
 
 subsection \<open>Quantifier Identities\<close>
 
 lemma quant_ids:
   "eval e f g (Iff (Neg (Exists p)) (Forall (Neg p)))"
   "eval e f g (Iff (Neg (Forall p)) (Exists (Neg p)))"
   "eval e f g (Iff (And p (Forall q)) (Forall (And (lift p) q)))"
   "eval e f g (Iff (And p (Exists q)) (Exists (And (lift p) q)))"
   "eval e f g (Iff (Or p (Forall q)) (Forall (Or (lift p) q)))"
   "eval e f g (Iff (Or p (Exists q)) (Exists (Or (lift p) q)))"
   (* ... *)
   by (auto simp: Iff_def)
 
 (* We'd need a bit of more machinery to deal with "\<forall>x y. P(x,y) \<longleftrightarrow> \<forall>y x. P(x, y)":
  * swapping of de Bruijn indices (perhaps arbitrary permutation?) *) 
 
 
 subsection \<open>Function symbols and predicates, with arities.\<close>
 
 primrec predas_form :: "('a, 'b) form \<Rightarrow> ('b \<times> nat) set" where
   "predas_form FF = {}"
 | "predas_form TT = {}"
 | "predas_form (Pred b ts) = {(b, length ts)}"
 | "predas_form (And p q) = predas_form p \<union> predas_form q"
 | "predas_form (Or p q) = predas_form p \<union> predas_form q"
 | "predas_form (Impl p q) = predas_form p \<union> predas_form q"
 | "predas_form (Neg p) = predas_form p"
 | "predas_form (Forall p) = predas_form p"
 | "predas_form (Exists p) = predas_form p"
 
 primrec funas_term :: "'a term \<Rightarrow> ('a \<times> nat) set" where
   "funas_term (Var x) = {}"
 | "funas_term (App f ts) = {(f, length ts)} \<union> \<Union>(set (map funas_term ts))"
 
 primrec terms_form :: "('a, 'b) form \<Rightarrow> 'a term set" where
   "terms_form FF = {}"
 | "terms_form TT = {}"
 | "terms_form (Pred b ts) = set ts"
 | "terms_form (And p q) = terms_form p \<union> terms_form q"
 | "terms_form (Or p q) = terms_form p \<union> terms_form q"
 | "terms_form (Impl p q) = terms_form p \<union> terms_form q"
 | "terms_form (Neg p) = terms_form p"
 | "terms_form (Forall p) = terms_form p"
 | "terms_form (Exists p) = terms_form p"
 
 definition funas_form :: "('a, 'b) form \<Rightarrow> ('a \<times> nat) set" where
   "funas_form f \<equiv> \<Union>(funas_term ` terms_form f)"
 
 
 subsection \<open>Negation Normal Form\<close>
 
 inductive is_nnf :: "('a, 'b) form \<Rightarrow> bool" where
   "is_nnf TT"
 | "is_nnf FF"
 | "is_nnf (Pred p ts)"
 | "is_nnf (Neg (Pred p ts))"
 | "is_nnf p \<Longrightarrow> is_nnf q \<Longrightarrow> is_nnf (And p q)"
 | "is_nnf p \<Longrightarrow> is_nnf q \<Longrightarrow> is_nnf (Or p q)"
 | "is_nnf p \<Longrightarrow> is_nnf (Forall p)"
 | "is_nnf p \<Longrightarrow> is_nnf (Exists p)"
 
 primrec nnf' :: "bool \<Rightarrow> ('a, 'b) form \<Rightarrow> ('a, 'b) form" where
   "nnf' b TT          = (if b then TT else FF)"
 | "nnf' b FF          = (if b then FF else TT)"
 | "nnf' b (Pred p ts) = (if b then id else Neg) (Pred p ts)"
 | "nnf' b (And p q)   = (if b then And else Or) (nnf' b p) (nnf' b q)"
 | "nnf' b (Or p q)    = (if b then Or else And) (nnf' b p) (nnf' b q)"
 | "nnf' b (Impl p q)  = (if b then Or else And) (nnf' (\<not> b) p) (nnf' b q)"
 | "nnf' b (Neg p)     = nnf' (\<not> b) p"
 | "nnf' b (Forall p)  = (if b then Forall else Exists) (nnf' b p)"
 | "nnf' b (Exists p)  = (if b then Exists else Forall) (nnf' b p)"
 
 lemma eval_nnf':
   "eval e f g (nnf' b p) \<longleftrightarrow> (eval e f g p \<longleftrightarrow> b)"
   by (induct p arbitrary: e b) auto
 
 lemma is_nnf_nnf':
   "is_nnf (nnf' b p)"
   by (induct p arbitrary: b) (auto intro: is_nnf.intros)
 
 abbreviation nnf where
   "nnf \<equiv> nnf' True"
 
 lemmas nnf_simpls [simp] = eval_nnf'[where b = True, unfolded eq_True] is_nnf_nnf'[where b = True]
 
 
 subsection \<open>Reasoning modulo ACI01\<close>
 
 datatype ('a, 'b) form_aci
   = TT_aci
   | FF_aci
   | Pred_aci bool 'b "'a term list"
   | And_aci "('a, 'b) form_aci fset"
   | Or_aci "('a, 'b) form_aci fset"
   | Forall_aci "('a, 'b) form_aci"
   | Exists_aci "('a, 'b) form_aci"
 
 text \<open>evaluation, see @{const eval}\<close>
 
 primrec eval_aci :: \<open>(nat \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'c list \<Rightarrow> 'c) \<Rightarrow>
   ('b \<Rightarrow> 'c list \<Rightarrow> bool) \<Rightarrow> ('a, 'b) form_aci \<Rightarrow> bool\<close> where
   "eval_aci e f g FF_aci            \<longleftrightarrow> False"
 | "eval_aci e f g TT_aci            \<longleftrightarrow> True"
 | "eval_aci e f g (Pred_aci b a ts) \<longleftrightarrow> (g a (evalts e f ts) \<longleftrightarrow> b)"
 | "eval_aci e f g (And_aci ps)      \<longleftrightarrow> fBall (fimage (eval_aci e f g) ps) id"
 | "eval_aci e f g (Or_aci ps)       \<longleftrightarrow> fBex (fimage (eval_aci e f g) ps) id"
 | "eval_aci e f g (Forall_aci p)    \<longleftrightarrow> (\<forall>z. eval_aci (e\<langle>0:z\<rangle>) f g p)"
 | "eval_aci e f g (Exists_aci p)    \<longleftrightarrow> (\<exists>z. eval_aci (e\<langle>0:z\<rangle>) f g p)"
 
 text \<open>smart constructor: conjunction\<close>
 
 fun and_aci where
   "and_aci FF_aci       _            = FF_aci"
 | "and_aci _            FF_aci       = FF_aci"
 | "and_aci TT_aci       q            = q"
 | "and_aci p            TT_aci       = p"
 | "and_aci (And_aci ps) (And_aci qs) = And_aci (ps |\<union>| qs)"
 | "and_aci (And_aci ps) q            = And_aci (ps |\<union>| {|q|})"
 | "and_aci p            (And_aci qs) = And_aci ({|p|} |\<union>| qs)"
 | "and_aci p            q            = (if p = q then p else And_aci {|p,q|})"
 
 lemma eval_and_aci [simp]:
   "eval_aci e f g (and_aci p q) \<longleftrightarrow> eval_aci e f g p \<and> eval_aci e f g q"
-  by (cases "(p, q)" rule: and_aci.cases) (simp_all add: fBall_funion, meson+)
+  by (cases "(p, q)" rule: and_aci.cases) (simp_all add: ball_Un, meson+)
 
 declare and_aci.simps [simp del]
 
 text \<open>smart constructor: disjunction\<close>
 
 fun or_aci where
   "or_aci TT_aci       _            = TT_aci"
 | "or_aci _            TT_aci       = TT_aci"
 | "or_aci FF_aci       q            = q"
 | "or_aci p            FF_aci       = p"
 | "or_aci (Or_aci ps)  (Or_aci qs)  = Or_aci (ps |\<union>| qs)"
 | "or_aci (Or_aci ps)  q            = Or_aci (ps |\<union>| {|q|})"
 | "or_aci p            (Or_aci qs)  = Or_aci ({|p|} |\<union>| qs)"
 | "or_aci p            q            = (if p = q then p else Or_aci {|p,q|})"
 
 lemma eval_or_aci [simp]:
   "eval_aci e f g (or_aci p q) \<longleftrightarrow> eval_aci e f g p \<or> eval_aci e f g q"
-  by (cases "(p, q)" rule: or_aci.cases) (simp_all add: fBex_funion, meson+)
+  by (cases "(p, q)" rule: or_aci.cases) (simp_all add: bex_Un, meson+)
 
 declare or_aci.simps [simp del]
 
 text \<open>convert negation normal form to ACIU01 normal form\<close>
 
 fun nnf_to_aci :: "('a, 'b) form \<Rightarrow> ('a, 'b) form_aci" where
   "nnf_to_aci FF                = FF_aci"
 | "nnf_to_aci TT                = TT_aci"
 | "nnf_to_aci (Pred b ts)       = Pred_aci True b ts"
 | "nnf_to_aci (Neg (Pred b ts)) = Pred_aci False b ts"
 | "nnf_to_aci (And p q)         = and_aci (nnf_to_aci p) (nnf_to_aci q)"
 | "nnf_to_aci (Or p q)          = or_aci (nnf_to_aci p) (nnf_to_aci q)"
 | "nnf_to_aci (Forall p)        = Forall_aci (nnf_to_aci p)"
 | "nnf_to_aci (Exists p)        = Exists_aci (nnf_to_aci p)"
 | "nnf_to_aci _                 = undefined" (* the remaining cases are impossible for NNFs *)
 
 lemma eval_nnf_to_aci:
   "is_nnf p \<Longrightarrow> eval_aci e f g (nnf_to_aci p) \<longleftrightarrow> eval e f g p"
   by (induct p arbitrary: e rule: is_nnf.induct) simp_all
 
 
 subsection \<open>A (mostly) Propositional Equivalence Check\<close>
 
 text \<open>We reason modulo $\forall = \neg\exists\neg$, de Morgan, double negation, and
   ACUI01 of $\vee$ and $\wedge$, by converting to negation normal form, and then collapsing
   conjunctions and disjunctions taking units, absorption, commutativity, associativity, and
   idempotence into account. We only need soundness for a certifier.\<close>
 
 lemma check_equivalence_by_nnf_aci:
   "nnf_to_aci (nnf p) = nnf_to_aci (nnf q) \<Longrightarrow> eval e f g p \<longleftrightarrow> eval e f g q"
   by (metis eval_nnf_to_aci is_nnf_nnf' eval_nnf')
 
 
 subsection \<open>Reasoning modulo ACI01\<close>
 
 datatype ('a, 'b) form_list_aci
   = TT_aci
   | FF_aci
   | Pred_aci bool 'b "'a term list"
   | And_aci "('a, 'b) form_list_aci list"
   | Or_aci "('a, 'b) form_list_aci list"
   | Forall_aci "('a, 'b) form_list_aci"
   | Exists_aci "('a, 'b) form_list_aci"
 
 text \<open>evaluation, see @{const eval}\<close>
 
 fun eval_list_aci :: \<open>(nat \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'c list \<Rightarrow> 'c) \<Rightarrow>
   ('b \<Rightarrow> 'c list \<Rightarrow> bool) \<Rightarrow> ('a, 'b) form_list_aci \<Rightarrow> bool\<close> where
   "eval_list_aci e f g FF_aci            \<longleftrightarrow> False"
 | "eval_list_aci e f g TT_aci            \<longleftrightarrow> True"
 | "eval_list_aci e f g (Pred_aci b a ts) \<longleftrightarrow> (g a (evalts e f ts) \<longleftrightarrow> b)"
 | "eval_list_aci e f g (And_aci ps)      \<longleftrightarrow> list_all (\<lambda> fm. eval_list_aci e f g fm) ps"
 | "eval_list_aci e f g (Or_aci ps)       \<longleftrightarrow> list_ex (\<lambda> fm. eval_list_aci e f g fm) ps"
 | "eval_list_aci e f g (Forall_aci p)    \<longleftrightarrow> (\<forall>z. eval_list_aci (e\<langle>0:z\<rangle>) f g p)"
 | "eval_list_aci e f g (Exists_aci p)    \<longleftrightarrow> (\<exists>z. eval_list_aci (e\<langle>0:z\<rangle>) f g p)"
 
 text \<open>smart constructor: conjunction\<close>
 
 fun and_list_aci where
   "and_list_aci FF_aci       _            = FF_aci"
 | "and_list_aci _            FF_aci       = FF_aci"
 | "and_list_aci TT_aci       q            = q"
 | "and_list_aci p            TT_aci       = p"
 | "and_list_aci (And_aci ps) (And_aci qs) = And_aci (remdups (ps @ qs))"
 | "and_list_aci (And_aci ps) q            = And_aci (List.insert q ps)"
 | "and_list_aci p            (And_aci qs) = And_aci (List.insert p qs)"
 | "and_list_aci p            q            = (if p = q then p else And_aci [p,q])"
 
 lemma eval_and_list_aci [simp]:
   "eval_list_aci e f g (and_list_aci p q) \<longleftrightarrow> eval_list_aci e f g p \<and> eval_list_aci e f g q"
   apply (cases "(p, q)" rule: and_list_aci.cases)
   apply (simp_all add: list.pred_set list_ex_iff)
   apply blast+
   done
 
 declare and_list_aci.simps [simp del]
 
 text \<open>smart constructor: disjunction\<close>
 
 fun or_list_aci where
   "or_list_aci TT_aci       _            = TT_aci"
 | "or_list_aci _            TT_aci       = TT_aci"
 | "or_list_aci FF_aci       q            = q"
 | "or_list_aci p            FF_aci       = p"
 | "or_list_aci (Or_aci ps)  (Or_aci qs)  = Or_aci (remdups (ps @ qs))"
 | "or_list_aci (Or_aci ps)  q            = Or_aci (List.insert q ps)"
 | "or_list_aci p            (Or_aci qs)  = Or_aci (List.insert p qs)"
 | "or_list_aci p            q            = (if p = q then p else Or_aci [p,q])"
 
 lemma eval_or_list_aci [simp]:
   "eval_list_aci e f g (or_list_aci p q) \<longleftrightarrow> eval_list_aci e f g p \<or> eval_list_aci e f g q"
   by (cases "(p, q)" rule: or_list_aci.cases) (simp_all add: list.pred_set list_ex_iff, blast+)
 
 declare or_list_aci.simps [simp del]
 
 text \<open>convert negation normal form to ACIU01 normal form\<close>
 
 fun nnf_to_list_aci :: "('a, 'b) form \<Rightarrow> ('a, 'b) form_list_aci" where
   "nnf_to_list_aci FF                = FF_aci"
 | "nnf_to_list_aci TT                = TT_aci"
 | "nnf_to_list_aci (Pred b ts)       = Pred_aci True b ts"
 | "nnf_to_list_aci (Neg (Pred b ts)) = Pred_aci False b ts"
 | "nnf_to_list_aci (And p q)         = and_list_aci (nnf_to_list_aci p) (nnf_to_list_aci q)"
 | "nnf_to_list_aci (Or p q)          = or_list_aci (nnf_to_list_aci p) (nnf_to_list_aci q)"
 | "nnf_to_list_aci (Forall p)        = Forall_aci (nnf_to_list_aci p)"
 | "nnf_to_list_aci (Exists p)        = Exists_aci (nnf_to_list_aci p)"
 | "nnf_to_list_aci _                 = undefined" (* the remaining cases are impossible for NNFs *)
 
 lemma eval_nnf_to_list_aci:
   "is_nnf p \<Longrightarrow> eval_list_aci e f g (nnf_to_list_aci p) \<longleftrightarrow> eval e f g p"
   by (induct p arbitrary: e rule: is_nnf.induct) simp_all
 
 subsection \<open>A (mostly) Propositional Equivalence Check\<close>
 
 text \<open>We reason modulo $\forall = \neg\exists\neg$, de Morgan, double negation, and
   ACUI01 of $\vee$ and $\wedge$, by converting to negation normal form, and then collapsing
   conjunctions and disjunctions taking units, absorption, commutativity, associativity, and
   idempotence into account. We only need soundness for a certifier.\<close>
 
 derive linorder "term"
 derive compare "term"
 derive linorder form_list_aci
 derive compare form_list_aci
 
 fun ord_form_list_aci where
   "ord_form_list_aci TT_aci = TT_aci"
 | "ord_form_list_aci FF_aci = FF_aci"
 | "ord_form_list_aci (Pred_aci bool b ts) = Pred_aci bool b ts"
 | "ord_form_list_aci (And_aci fm) = (And_aci (sort (map ord_form_list_aci fm)))"
 | "ord_form_list_aci (Or_aci fm) = (Or_aci (sort (map ord_form_list_aci fm)))"
 | "ord_form_list_aci (Forall_aci fm) = (Forall_aci (ord_form_list_aci fm))"
 | "ord_form_list_aci (Exists_aci fm) = Exists_aci (ord_form_list_aci fm)"
 
 lemma and_list_aci_simps:
   "and_list_aci TT_aci q = q"
   "and_list_aci q FF_aci = FF_aci"
   by (cases q, auto simp add: and_list_aci.simps)+
 
 lemma ord_form_list_idemp:
   "ord_form_list_aci (ord_form_list_aci q) = ord_form_list_aci q"
   apply (induct q) apply (auto simp: list.set_map)
   apply (smt imageE list.set_map map_idI set_sort sorted_sort_id sorted_sort_key)+
   done
 
 lemma eval_lsit_aci_ord_form_list_aci:
   "eval_list_aci e f g (ord_form_list_aci p) \<longleftrightarrow> eval_list_aci e f g p"
   by (induct p arbitrary: e) (auto simp: list.pred_set list_ex_iff)
 
 lemma check_equivalence_by_nnf_sortedlist_aci:
   "ord_form_list_aci (nnf_to_list_aci (nnf p)) = ord_form_list_aci (nnf_to_list_aci (nnf q)) \<Longrightarrow> eval e f g p \<longleftrightarrow> eval e f g q"
   by (metis eval_nnf_to_list_aci eval_lsit_aci_ord_form_list_aci is_nnf_nnf' eval_nnf')
 
 hide_type (open) "term"
 hide_const (open) Var
 hide_type (open) ctxt
 
 end
\ No newline at end of file
diff --git a/thys/Higher_Order_Terms/Term_to_Nterm.thy b/thys/Higher_Order_Terms/Term_to_Nterm.thy
--- a/thys/Higher_Order_Terms/Term_to_Nterm.thy
+++ b/thys/Higher_Order_Terms/Term_to_Nterm.thy
@@ -1,657 +1,665 @@
 chapter \<open>Converting between \<open>term\<close>s and \<open>nterm\<close>s\<close>
 
 theory Term_to_Nterm
 imports
   Fresh_Class
   Find_First
   Term
   Nterm
 begin
 
 section \<open>\<open>\<alpha>\<close>-equivalence\<close>
 
 inductive alpha_equiv :: "(name, name) fmap \<Rightarrow> nterm \<Rightarrow> nterm \<Rightarrow> bool" where
 const: "alpha_equiv env (Nconst x) (Nconst x)" |
 var1: "x |\<notin>| fmdom env \<Longrightarrow> x |\<notin>| fmran env \<Longrightarrow> alpha_equiv env (Nvar x) (Nvar x)" |
 var2: "fmlookup env x = Some y \<Longrightarrow> alpha_equiv env (Nvar x) (Nvar y)" |
 abs: "alpha_equiv (fmupd x y env) n1 n2 \<Longrightarrow> alpha_equiv env (\<Lambda>\<^sub>n x. n1) (\<Lambda>\<^sub>n y. n2)" |
 app: "alpha_equiv env n1 n2 \<Longrightarrow> alpha_equiv env m1 m2 \<Longrightarrow> alpha_equiv env (n1 $\<^sub>n m1) (n2 $\<^sub>n m2)"
 
 code_pred alpha_equiv .
 
 abbreviation alpha_eq :: "nterm \<Rightarrow> nterm \<Rightarrow> bool" (infixl "\<approx>\<^sub>\<alpha>" 50) where
 "alpha_eq n1 n2 \<equiv> alpha_equiv fmempty n1 n2"
 
 lemma alpha_equiv_refl[intro?]:
   assumes "fmpred (=) \<Gamma>"
   shows "alpha_equiv \<Gamma> t t"
 using assms proof (induction t arbitrary: \<Gamma>)
   case Napp
   show ?case
     apply (rule alpha_equiv.app; rule Napp)
     using Napp.prems unfolding fdisjnt_alt_def by auto
 qed (auto simp: fdisjnt_alt_def intro: alpha_equiv.intros)
 
 corollary alpha_eq_refl: "alpha_eq t t"
 by (auto intro: alpha_equiv_refl)
 
 section \<open>From @{typ term} to @{typ nterm}\<close>
 
 fun term_to_nterm :: "name list \<Rightarrow> term \<Rightarrow> (name, nterm) state" where
 "term_to_nterm _ (Const name) = State_Monad.return (Nconst name)" |
 "term_to_nterm _ (Free name) = State_Monad.return (Nvar name)" |
 "term_to_nterm \<Gamma> (Bound n) = State_Monad.return (Nvar (\<Gamma> ! n))" |
 "term_to_nterm \<Gamma> (\<Lambda> t) = do {
   n \<leftarrow> fresh_create;
   e \<leftarrow> term_to_nterm (n # \<Gamma>) t;
   State_Monad.return (\<Lambda>\<^sub>n n. e)
 }" |
 "term_to_nterm \<Gamma> (t\<^sub>1 $ t\<^sub>2) = do {
   e\<^sub>1 \<leftarrow> term_to_nterm \<Gamma> t\<^sub>1;
   e\<^sub>2 \<leftarrow> term_to_nterm \<Gamma> t\<^sub>2;
   State_Monad.return (e\<^sub>1 $\<^sub>n e\<^sub>2)
 }"
 
 lemmas term_to_nterm_induct = term_to_nterm.induct[case_names const free bound abs app]
 
 lemma term_to_nterm:
   assumes "no_abs t"
   shows "fst (run_state (term_to_nterm \<Gamma> t) x) = convert_term t"
 using assms
 apply (induction arbitrary: x)
 apply auto
 by (auto simp: free_term_def free_nterm_def const_term_def const_nterm_def app_term_def app_nterm_def split_beta split: prod.splits)
 
 definition term_to_nterm' :: "term \<Rightarrow> nterm" where
 "term_to_nterm' t = frun_fresh (term_to_nterm [] t) (frees t)"
 
 lemma term_to_nterm_mono: "mono_state (term_to_nterm \<Gamma> x)"
 by (induction \<Gamma> x rule: term_to_nterm.induct) (auto intro: bind_mono_strong)
 
 lemma term_to_nterm_vars0:
   assumes "wellformed' (length \<Gamma>) t"
   shows "frees (fst (run_state (term_to_nterm \<Gamma> t) s)) |\<subseteq>| frees t |\<union>| fset_of_list \<Gamma>"
 using assms proof (induction \<Gamma> t arbitrary: s rule: term_to_nterm_induct)
   case (bound \<Gamma> i)
   hence "\<Gamma> ! i |\<in>| fset_of_list \<Gamma>"
     including fset.lifting by transfer auto
   thus ?case
     by (auto simp: State_Monad.return_def)
 next
   case (abs \<Gamma> t)
   let ?x = "next s"
 
   from abs have "frees (fst (run_state (term_to_nterm (?x # \<Gamma>) t) ?x)) |\<subseteq>| frees t |\<union>| {|?x|} |\<union>| fset_of_list \<Gamma>"
     by simp
   thus ?case
     by (auto simp: create_alt_def split_beta)
 qed (auto simp: split_beta)
 
 corollary term_to_nterm_vars:
   assumes "wellformed t"
   shows "frees (fresh_frun (term_to_nterm [] t) F) |\<subseteq>| frees t"
 proof -
   let ?\<Gamma> = "[]"
   from assms have "wellformed' (length ?\<Gamma>) t"
     by simp
   hence "frees (fst (run_state (term_to_nterm ?\<Gamma> t) (fNext F))) |\<subseteq>| (frees t |\<union>| fset_of_list ?\<Gamma>)"
     by (rule term_to_nterm_vars0)
   thus ?thesis
     by (simp add: fresh_fNext_def fresh_frun_def)
 qed
 
 corollary term_to_nterm_closed: "closed t \<Longrightarrow> wellformed t \<Longrightarrow> closed (term_to_nterm' t)"
 using term_to_nterm_vars[where F = "frees t" and t = t, simplified]
 unfolding closed_except_def term_to_nterm'_def
 by (simp add: fresh_frun_def)
 
 lemma term_to_nterm_consts: "pred_state (\<lambda>t'. consts t' = consts t) (term_to_nterm \<Gamma> t)"
 apply (rule pred_stateI)
 apply (induction t arbitrary: \<Gamma>)
 apply (auto split: prod.splits)
 done
 
 section \<open>From @{typ nterm} to @{typ term}\<close>
 
 fun nterm_to_term :: "name list \<Rightarrow> nterm \<Rightarrow> term" where
 "nterm_to_term \<Gamma> (Nconst name) = Const name" |
 "nterm_to_term \<Gamma> (Nvar name) = (case find_first name \<Gamma> of Some n \<Rightarrow> Bound n | None \<Rightarrow> Free name)" |
 "nterm_to_term \<Gamma> (t $\<^sub>n u) = nterm_to_term \<Gamma> t $ nterm_to_term \<Gamma> u" |
 "nterm_to_term \<Gamma> (\<Lambda>\<^sub>n x. t) = \<Lambda> nterm_to_term (x # \<Gamma>) t"
 
 lemma nterm_to_term:
   assumes "no_abs t" "fdisjnt (fset_of_list \<Gamma>) (frees t)"
   shows "nterm_to_term \<Gamma> t = convert_term t"
 using assms proof (induction arbitrary: \<Gamma>)
   case (free name)
   then show ?case
     apply simp
     apply (auto simp: free_nterm_def free_term_def fdisjnt_alt_def split: option.splits)
     apply (rule find_first_none)
     by (metis fset_of_list_elem)
 next
   case (const name)
   show ?case
     apply simp
     by (simp add: const_nterm_def const_term_def)
 next
   case (app t\<^sub>1 t\<^sub>2)
   then have "nterm_to_term \<Gamma> t\<^sub>1 = convert_term t\<^sub>1" "nterm_to_term \<Gamma> t\<^sub>2 = convert_term t\<^sub>2"
     by (auto simp: fdisjnt_alt_def finter_funion_distrib)
   then show ?case
     apply simp
     by (simp add: app_nterm_def app_term_def)
 qed
 
 abbreviation "nterm_to_term' \<equiv> nterm_to_term []"
 
 lemma nterm_to_term': "no_abs t \<Longrightarrow> nterm_to_term' t = convert_term t"
 by (auto simp: fdisjnt_alt_def nterm_to_term)
 
 lemma nterm_to_term_frees[simp]: "frees (nterm_to_term \<Gamma> t) = frees t - fset_of_list \<Gamma>"
 proof (induction t arbitrary: \<Gamma>)
   case (Nvar name)
   show ?case
     proof (cases "find_first name \<Gamma>")
       case None
       hence "name |\<notin>| fset_of_list \<Gamma>"
         including fset.lifting
         by transfer (metis find_first_some option.distinct(1))
       with None show ?thesis
         by auto
     next
       case (Some u)
       hence "name |\<in>| fset_of_list \<Gamma>"
         including fset.lifting
         by transfer (metis find_first_none option.distinct(1))
       with Some show ?thesis
         by auto
     qed
   qed (auto split: option.splits)
 
 section \<open>Correctness\<close>
 
 text \<open>Some proofs in this section have been contributed by Yu Zhang.\<close>
 
 lemma term_to_nterm_nterm_to_term0:
   assumes "wellformed' (length \<Gamma>) t" "fdisjnt (fset_of_list \<Gamma>) (frees t)" "distinct \<Gamma>"
   assumes "fBall (frees t |\<union>| fset_of_list \<Gamma>) (\<lambda>x. x \<le> s)"
   shows "nterm_to_term \<Gamma> (fst (run_state (term_to_nterm \<Gamma> t) s)) = t"
 using assms proof (induction \<Gamma> t arbitrary: s rule: term_to_nterm_induct)
   case (free \<Gamma> name)
   hence "fdisjnt (fset_of_list \<Gamma>) {|name|}"
     by simp
   hence "name \<notin> set \<Gamma>"
     including fset.lifting by transfer' (simp add: disjnt_def)
   hence "find_first name \<Gamma> = None"
     by (rule find_first_none)
   thus ?case
     by (simp add: State_Monad.return_def)
 next
   case (bound \<Gamma> i)
   thus ?case
     by (simp add: State_Monad.return_def find_first_some_index)
 next
   case (app \<Gamma> t\<^sub>1 t\<^sub>2)
   have "fdisjnt (fset_of_list \<Gamma>) (frees t\<^sub>1)"
     apply (rule fdisjnt_subset_right[where N = "frees t\<^sub>1 |\<union>| frees t\<^sub>2"])
     using app by auto
   have "fdisjnt (fset_of_list \<Gamma>) (frees t\<^sub>2)"
     apply (rule fdisjnt_subset_right[where N = "frees t\<^sub>1 |\<union>| frees t\<^sub>2"])
     using app by auto
 
   have s: "s \<le> snd (run_state (term_to_nterm \<Gamma> t\<^sub>1) s)"
     apply (rule state_io_relD[OF term_to_nterm_mono])
     apply (rule surjective_pairing)
     done
 
   show ?case
     apply (auto simp: split_beta)
     subgoal
       apply (rule app)
       subgoal using app by simp
       subgoal by fact
       subgoal by fact
       using app by auto
     subgoal
       apply (rule app)
       subgoal using app by simp
       subgoal by fact
       subgoal by fact
       using app s by force+
     done
 next
   case (abs \<Gamma> t)
 
   have "next s |\<notin>| frees t |\<union>| fset_of_list \<Gamma>"
-    using abs(5)[simplified]
-    by (rule next_ge_fall)
+    using abs(5) next_ge_fall by auto
 
   have "nterm_to_term (next s # \<Gamma>) (fst (run_state (term_to_nterm (next s # \<Gamma>) t) (next s))) = t"
     proof (subst abs)
       show "wellformed' (length (next s # \<Gamma>)) t"
         using abs by auto
       show "fdisjnt (fset_of_list (next s # \<Gamma>)) (frees t)"
         apply simp
         apply (rule fdisjnt_insert)
         using \<open>next s |\<notin>| frees t |\<union>| fset_of_list \<Gamma>\<close> abs by auto
       show "distinct (next s # \<Gamma>)"
         apply simp
         apply rule
         using \<open>next s |\<notin>| frees t |\<union>| fset_of_list \<Gamma>\<close> apply (simp add: fset_of_list_elem)
         apply fact
         done
-      show "fBall (frees t |\<union>| fset_of_list (next s # \<Gamma>)) (\<lambda>x. x \<le> next s)"
-        using abs(5) apply simp
-        apply (rule fBall_pred_weaken[where P = "\<lambda>x. x \<le> s"])
-        subgoal
-          apply simp
-          by (meson dual_order.strict_implies_order dual_order.strict_trans2 fresh_class.next_ge)
-        subgoal by assumption
-        done
+      have "fBall (frees t |\<union>| fset_of_list \<Gamma>) (\<lambda>x. x \<le> next s)"
+      proof (rule fBall_pred_weaken)
+        show "fBall (frees t |\<union>| fset_of_list \<Gamma>) (\<lambda>x. x \<le> s)"
+          using abs(5) by simp
+      next
+        show "\<And>x. x |\<in>| frees t |\<union>| fset_of_list \<Gamma> \<Longrightarrow> x \<le> s \<Longrightarrow> x \<le> next s"
+          by (metis Fresh_Class.next_ge dual_order.strict_trans less_eq_name_def)
+      qed
+      thus "fBall (frees t |\<union>| fset_of_list (next s # \<Gamma>)) (\<lambda>x. x \<le> next s)"
+        by simp
     qed auto
 
   thus ?case
     by (auto simp: split_beta create_alt_def)
 qed (auto simp: State_Monad.return_def)
 
 lemma term_to_nterm_nterm_to_term:
   assumes "wellformed t" "frees t |\<subseteq>| S"
   shows "nterm_to_term' (frun_fresh (term_to_nterm [] t) (S |\<union>| Q)) = t"
 proof (rule term_to_nterm_nterm_to_term0)
   show "wellformed' (length []) t"
     using assms by simp
 next
   show "fdisjnt (fset_of_list []) (frees t)"
     unfolding fdisjnt_alt_def by simp
 next
   have "fBall (S |\<union>| Q) (\<lambda>x. x < fresh.fNext next default (S |\<union>| Q))"
     by (metis fNext_geq_not_member fresh_fNext_def le_less_linear fBallI)
   hence "fBall (S |\<union>| Q) (\<lambda>x. x \<le> fresh.fNext next default (S |\<union>| Q))"
     by (meson fBall_pred_weaken less_eq_name_def)
   thus "fBall (frees t |\<union>| fset_of_list []) (\<lambda>x. x \<le> fresh.fNext next default (S |\<union>| Q))"
     using \<open>frees t |\<subseteq>| S\<close>
     by auto
 qed simp
 
 corollary term_to_nterm_nterm_to_term_simple:
   assumes "wellformed t"
   shows "nterm_to_term' (term_to_nterm' t) = t"
 unfolding term_to_nterm'_def using assms
 by (metis order_refl sup.idem term_to_nterm_nterm_to_term)
 
 lemma nterm_to_term_eq:
   assumes "frees u |\<subseteq>| fset_of_list (common_prefix \<Gamma> \<Gamma>')"
   shows "nterm_to_term \<Gamma> u = nterm_to_term \<Gamma>' u"
 using assms
 proof (induction u arbitrary: \<Gamma> \<Gamma>')
   case (Nvar name)
   hence "name \<in> set (common_prefix \<Gamma> \<Gamma>')"
     unfolding frees_nterm.simps
     including fset.lifting
     by transfer' simp
   thus ?case
     by (auto simp: common_prefix_find)
 next
   case (Nabs x t)
   hence *: "frees t - {|x|} |\<subseteq>| fset_of_list (common_prefix \<Gamma> \<Gamma>')"
     by simp
 
   show ?case
     apply simp
     apply (rule Nabs)
     using * Nabs by auto
 qed auto
 
 corollary nterm_to_term_eq_closed: "closed t \<Longrightarrow> nterm_to_term \<Gamma> t = nterm_to_term \<Gamma>' t"
 by (rule nterm_to_term_eq) (auto simp: closed_except_def)
 
 lemma nterm_to_term_wellformed: "wellformed' (length \<Gamma>) (nterm_to_term \<Gamma> t)"
 proof (induction t arbitrary: \<Gamma>)
   case (Nabs x t)
   hence "wellformed' (Suc (length \<Gamma>)) (nterm_to_term (x # \<Gamma>) t)"
     by (metis length_Cons)
   thus ?case
     by auto
 qed (auto simp: find_first_correct split: option.splits)
 
 corollary nterm_to_term_closed_wellformed: "closed t \<Longrightarrow> wellformed (nterm_to_term \<Gamma> t)"
 by (metis Ex_list_of_length nterm_to_term_eq_closed nterm_to_term_wellformed)
 
 lemma nterm_to_term_term_to_nterm:
   assumes "frees t |\<subseteq>| fset_of_list \<Gamma>" "length \<Gamma> = length \<Gamma>'"
   shows "alpha_equiv (fmap_of_list (zip \<Gamma> \<Gamma>')) t (fst (run_state (term_to_nterm \<Gamma>' (nterm_to_term \<Gamma> t)) s))"
 using assms proof (induction \<Gamma> t arbitrary: s \<Gamma>' rule:nterm_to_term.induct)
   case (4 \<Gamma> x t)
   show ?case
     apply (simp add: split_beta)
     apply (rule alpha_equiv.abs)
     using "4.IH"[where \<Gamma>' = "next s # \<Gamma>'"] "4.prems"
     by (fastforce simp: create_alt_def intro: alpha_equiv.intros)
 qed
   (force split: option.splits intro: find_first_some intro!: alpha_equiv.intros
          simp: fset_of_list_elem find_first_in_map split_beta fdisjnt_alt_def)+
 
 corollary nterm_to_term_term_to_nterm': "closed t \<Longrightarrow> t \<approx>\<^sub>\<alpha> term_to_nterm' (nterm_to_term' t)"
 unfolding term_to_nterm'_def closed_except_def
 apply (rule nterm_to_term_term_to_nterm[where \<Gamma> = "[]" and \<Gamma>' = "[]", simplified])
 by auto
 
 context begin
 
 private lemma term_to_nterm_alpha_equiv0:
   "length \<Gamma>1 = length \<Gamma>2 \<Longrightarrow> distinct \<Gamma>1 \<Longrightarrow> distinct \<Gamma>2 \<Longrightarrow> wellformed' (length \<Gamma>1) t1 \<Longrightarrow>
    fresh_fin (frees t1 |\<union>| fset_of_list \<Gamma>1) s1 \<Longrightarrow> fdisjnt (fset_of_list \<Gamma>1) (frees t1) \<Longrightarrow>
    fresh_fin (frees t1 |\<union>| fset_of_list \<Gamma>2) s2 \<Longrightarrow> fdisjnt (fset_of_list \<Gamma>2) (frees t1) \<Longrightarrow>
    alpha_equiv (fmap_of_list (zip \<Gamma>1 \<Gamma>2)) (fst( run_state (term_to_nterm \<Gamma>1 t1) s1)) (fst ( run_state (term_to_nterm \<Gamma>2 t1) s2))"
 proof (induction \<Gamma>1 t1 arbitrary: \<Gamma>2 s1 s2 rule:term_to_nterm_induct)
   case (free \<Gamma>1 name)
   then have "name |\<notin>| fmdom (fmap_of_list (zip \<Gamma>1 \<Gamma>2))"
     unfolding fdisjnt_alt_def
     by force
   moreover have "name |\<notin>| fmran (fmap_of_list (zip \<Gamma>1 \<Gamma>2))"
     apply rule
     apply (subst (asm) fmran_of_list)
     apply (subst (asm) fset_of_list_map[symmetric])
     apply (subst (asm) distinct_clearjunk_id)
     subgoal
       apply (subst map_fst_zip)
       apply fact
       apply fact
       done
     apply (subst (asm) map_snd_zip)
     apply fact
     using free unfolding fdisjnt_alt_def
     by fastforce
   ultimately show ?case
     by (force intro:alpha_equiv.intros)
 next
   case (abs \<Gamma> t)
   have *: "next s1 > s1" "next s2 > s2"
     using next_ge by force+
-  with abs have "next s1 \<notin> set \<Gamma>" "next s2 \<notin> set \<Gamma>2"
-    by (metis fBall_funion fset_of_list_elem next_ge_fall)+
-  have "fresh_fin (frees t |\<union>| fset_of_list \<Gamma>) (next s1)"
+  from abs.prems(5,7) have "next s1 \<notin> set \<Gamma>" "next s2 \<notin> set \<Gamma>2"
+    unfolding fBall_funion
+    by (metis fset_of_list_elem next_ge_fall)+
+  moreover have "fresh_fin (frees t |\<union>| fset_of_list \<Gamma>) (next s1)"
        "fresh_fin (frees t |\<union>| fset_of_list \<Gamma>2) (next s2)"
     using * abs
     by (smt dual_order.trans fBall_pred_weaken frees_term.simps(3) less_imp_le)+
-  have "fdisjnt (finsert (next s1) (fset_of_list \<Gamma>)) (frees t)"
+  moreover have "fdisjnt (finsert (next s1) (fset_of_list \<Gamma>)) (frees t)"
        "fdisjnt (finsert (next s2) (fset_of_list \<Gamma>2)) (frees t)"
     unfolding fdisjnt_alt_def using abs frees_term.simps
     by (metis fdisjnt_alt_def finter_finsert_right funionCI inf_commute next_ge_fall)+
-  have "wellformed' (Suc (length \<Gamma>2)) t"
+  moreover have "wellformed' (Suc (length \<Gamma>2)) t"
     using wellformed'.simps abs
     by (metis Suc_eq_plus1)
-  show ?case
-    apply (auto simp: split_beta create_alt_def)
-    apply rule
-    apply (rule abs.IH[of _ "next s2 # \<Gamma>2", simplified])
-    by (fact | rule)+
+  ultimately show ?case
+    using abs.prems(1,2,3)
+    by (auto simp: split_beta create_alt_def
+        intro: alpha_equiv.abs abs.IH[of _ "next s2 # \<Gamma>2", simplified])
 next
   case (app \<Gamma>1 t\<^sub>1 t\<^sub>2)
   hence "wellformed' (length \<Gamma>1) t\<^sub>1" "wellformed' (length \<Gamma>1) t\<^sub>2"
   and "fresh_fin (frees t\<^sub>1 |\<union>| fset_of_list \<Gamma>1) s1" "fresh_fin (frees t\<^sub>1 |\<union>| fset_of_list \<Gamma>2) s2"
   and "fdisjnt (fset_of_list \<Gamma>1) (frees t\<^sub>1)" "fdisjnt (fset_of_list \<Gamma>2) (frees t\<^sub>1)"
   and "fdisjnt (fset_of_list \<Gamma>1) (frees t\<^sub>2)" "fdisjnt (fset_of_list \<Gamma>2) (frees t\<^sub>2)"
     using app
     unfolding fdisjnt_alt_def
     by (auto simp: inf_sup_distrib1)
   have "s1 \<le> snd (run_state (term_to_nterm \<Gamma>1 t\<^sub>1) s1)" "s2 \<le> snd (run_state (term_to_nterm \<Gamma>2 t\<^sub>1) s2)"
     using term_to_nterm_mono
     by (simp add: state_io_rel_def)+
   hence "fresh_fin (frees t\<^sub>2 |\<union>| fset_of_list \<Gamma>1) (snd (run_state (term_to_nterm \<Gamma>1 t\<^sub>1) s1))"
     using \<open>fresh_fin (frees (t\<^sub>1 $ t\<^sub>2) |\<union>| fset_of_list \<Gamma>1) s1\<close>
     by force
 
   have "fresh_fin (frees t\<^sub>2 |\<union>| fset_of_list \<Gamma>2) (snd (run_state (term_to_nterm \<Gamma>2 t\<^sub>1) s2))"
     apply rule
     using app frees_term.simps \<open>s2 \<le> _\<close> dual_order.trans
-    by (metis fbspec funion_iff)
+    by (metis funion_iff)
 
   show ?case
     apply (auto simp: split_beta create_alt_def)
     apply (rule alpha_equiv.app)
     subgoal
-      apply (rule app)
-      apply (simp | fact)+
-      done
+      using app.IH
+      using \<open>fBall (frees t\<^sub>1 |\<union>| fset_of_list \<Gamma>1) (\<lambda>y. y \<le> s1)\<close>
+        \<open>fBall (frees t\<^sub>1 |\<union>| fset_of_list \<Gamma>2) (\<lambda>y. y \<le> s2)\<close>
+        \<open>fdisjnt (fset_of_list \<Gamma>1) (frees t\<^sub>1)\<close>
+        \<open>fdisjnt (fset_of_list \<Gamma>2) (frees t\<^sub>1)\<close> \<open>wellformed' (length \<Gamma>1) t\<^sub>1\<close>
+        app.prems(1) app.prems(2) app.prems(3) by blast
     subgoal
-      apply (rule app)
-      apply (simp | fact)+
-      done
+      using app.IH
+      using \<open>fBall (frees t\<^sub>2 |\<union>| fset_of_list \<Gamma>1) (\<lambda>y. y \<le> snd (run_state (term_to_nterm \<Gamma>1 t\<^sub>1) s1))\<close>
+        \<open>fBall (frees t\<^sub>2 |\<union>| fset_of_list \<Gamma>2) (\<lambda>y. y \<le> snd (run_state (term_to_nterm \<Gamma>2 t\<^sub>1) s2))\<close>
+        \<open>fdisjnt (fset_of_list \<Gamma>1) (frees t\<^sub>2)\<close>
+        \<open>fdisjnt (fset_of_list \<Gamma>2) (frees t\<^sub>2)\<close>
+        \<open>wellformed' (length \<Gamma>1) t\<^sub>2\<close>
+        app.prems(1) app.prems(2) app.prems(3) by blast
     done
 qed (force intro: alpha_equiv.intros simp: fmlookup_of_list in_set_zip)+
 
 lemma term_to_nterm_alpha_equiv:
   assumes "length \<Gamma>1 = length \<Gamma>2" "distinct \<Gamma>1" "distinct \<Gamma>2" "closed t"
   assumes "wellformed' (length \<Gamma>1) t"
   assumes "fresh_fin (fset_of_list \<Gamma>1) s1" "fresh_fin (fset_of_list \<Gamma>2) s2"
   shows "alpha_equiv (fmap_of_list (zip \<Gamma>1 \<Gamma>2)) (fst (run_state (term_to_nterm \<Gamma>1 t) s1)) (fst (run_state (term_to_nterm \<Gamma>2 t) s2))"
   \<comment> \<open>An instantiated version of this lemma with @{prop \<open>\<Gamma>1 = []\<close>} and @{prop \<open>\<Gamma>2 = []\<close>}
       would not make sense because then it would just be a special case of
       @{thm [source=true] alpha_eq_refl}.\<close>
 using assms
 by (simp add: fdisjnt_alt_def closed_except_def term_to_nterm_alpha_equiv0)
 
 end
 
 global_interpretation nrelated: term_struct_rel_strong "(\<lambda>t n. t = nterm_to_term \<Gamma> n)" for \<Gamma>
 proof (standard, goal_cases)
   case (5 name t)
   then show ?case by (cases t) (auto simp: const_term_def const_nterm_def split: option.splits)
 next
   case (6 u\<^sub>1 u\<^sub>2 t)
   then show ?case by (cases t) (auto simp: app_term_def app_nterm_def split: option.splits)
 qed (auto simp: const_term_def const_nterm_def app_term_def app_nterm_def)
 
 lemma env_nrelated_closed:
   assumes "nrelated.P_env \<Gamma> env nenv" "closed_env nenv"
   shows "nrelated.P_env \<Gamma>' env nenv"
 proof
   fix x
   from assms have "rel_option (\<lambda>t n. t = nterm_to_term \<Gamma> n) (fmlookup env x) (fmlookup nenv x)"
     by auto
   thus "rel_option (\<lambda>t n. t = nterm_to_term \<Gamma>' n) (fmlookup env x) (fmlookup nenv x)"
     using assms
     by (cases rule: option.rel_cases) (auto dest: fmdomI simp: nterm_to_term_eq_closed)
 qed
 
 lemma nrelated_subst:
   assumes "nrelated.P_env \<Gamma> env nenv" "closed_env nenv" "fdisjnt (fset_of_list \<Gamma>) (fmdom nenv)"
   shows "subst (nterm_to_term \<Gamma> t) env = nterm_to_term \<Gamma> (subst t nenv)"
 using assms
 proof (induction t arbitrary: \<Gamma> env nenv)
   case (Nvar name)
   thus ?case
     proof (cases rule: fmrel_cases[where x = name])
       case (some t\<^sub>1 t\<^sub>2)
       with Nvar have "name |\<notin>| fset_of_list \<Gamma>"
         unfolding fdisjnt_alt_def by (auto dest: fmdomI)
       hence "find_first name \<Gamma> = None"
         including fset.lifting by transfer' (simp add: find_first_none)
       with some show ?thesis
         by auto
     qed (auto split: option.splits)
 next
   case (Nabs x t)
   show ?case
     apply simp
     apply (subst subst_drop[symmetric, where x = x])
     subgoal by simp
     apply (rule Nabs)
     using Nabs unfolding fdisjnt_alt_def
     by (auto intro: env_nrelated_closed)
 qed auto
 
 lemma nterm_to_term_insert_dupl:
   assumes "y \<in> set (take n \<Gamma>)" "n \<le> length \<Gamma>"
   shows "nterm_to_term \<Gamma> t = incr_bounds (- 1) (Suc n) (nterm_to_term (insert_nth n y \<Gamma>) t)"
 using assms
 proof (induction t arbitrary: n \<Gamma>)
   case (Nvar name)
   show ?case
     proof (cases "y = name")
       case True
       with Nvar obtain i where "find_first name \<Gamma> = Some i" "i < n"
         by (auto elim: find_first_some_strong)
 
       hence "find_first name (take n \<Gamma>) = Some i"
         by (rule find_first_prefix)
 
       show ?thesis
         apply simp
         apply (subst \<open>find_first name \<Gamma> = Some i\<close>)
         apply simp
         apply (subst find_first_append)
         apply (subst \<open>find_first name (take n \<Gamma>) = Some i\<close>)
         apply simp
         using \<open>i < n\<close> by simp
     next
       case False
       show ?thesis
         apply (simp del: insert_nth_take_drop)
         apply (subst find_first_insert_nth_neq)
         subgoal using False by simp
         by (cases "find_first name \<Gamma>") auto
     qed
 next
   case (Nabs x t)
   show ?case
     apply simp
     apply (subst Nabs(1)[where n = "Suc n"])
     using Nabs by auto
 qed auto
 
 lemma nterm_to_term_bounds_dupl:
   assumes "i < length \<Gamma>" "j < length \<Gamma>" "i < j"
   assumes "\<Gamma> ! i = \<Gamma> ! j"
   shows "j |\<notin>| bounds (nterm_to_term \<Gamma> t)"
 using assms
 proof (induction t arbitrary: \<Gamma> i j)
   case (Nvar name)
   show ?case
     proof (cases "find_first name \<Gamma>")
       case (Some k)
       show ?thesis
         proof
           assume "j |\<in>| bounds (nterm_to_term \<Gamma> (Nvar name))"
           with Some have "find_first name \<Gamma> = Some j"
             by simp
 
           moreover have "find_first name \<Gamma> \<noteq> Some j"
             proof (rule find_first_later)
               show "i < length \<Gamma>" "j < length \<Gamma>" "i < j"
                 by fact+
             next
               show "\<Gamma> ! j = name"
                 by (rule find_first_correct) fact
               thus "\<Gamma> ! i = name"
                 using Nvar by simp
             qed
 
           ultimately show False
             by blast
         qed
     qed simp
 next
   case (Nabs x t)
   show ?case
     proof
       assume "j |\<in>| bounds (nterm_to_term \<Gamma> (\<Lambda>\<^sub>n x. t))"
       then obtain j' where "j' |\<in>| bounds (nterm_to_term (x # \<Gamma>) t)" "j' > 0" "j = j' - 1"
         by auto
       hence "Suc j |\<in>| bounds (nterm_to_term (x # \<Gamma>) t)"
         by simp
 
       moreover have "Suc j |\<notin>| bounds (nterm_to_term (x # \<Gamma>) t)"
         proof (rule Nabs)
           show "Suc i < length (x # \<Gamma>)" "Suc j < length (x # \<Gamma>)" "Suc i < Suc j" "(x # \<Gamma>) ! Suc i = (x # \<Gamma>) ! Suc j"
             using Nabs by simp+
         qed
 
       ultimately show False
         by blast
     qed
   qed auto
 
 fun subst_single :: "nterm \<Rightarrow> name \<Rightarrow> nterm \<Rightarrow> nterm" where
 "subst_single (Nvar s) s' t' = (if s = s' then t' else Nvar s)" |
 "subst_single (t\<^sub>1 $\<^sub>n t\<^sub>2) s' t' = subst_single t\<^sub>1 s' t' $\<^sub>n subst_single t\<^sub>2 s' t'" |
 "subst_single (\<Lambda>\<^sub>n x. t) s' t' = (\<Lambda>\<^sub>n x. (if x = s' then t else subst_single t s' t'))" |
 "subst_single t _ _ = t"
 
 lemma subst_single_eq: "subst_single t s t' = subst t (fmap_of_list [(s, t')])"
 proof (induction t)
   case (Nabs x t)
   then show ?case
     by (cases "x = s") (simp add: fmfilter_alt_defs)+
 qed auto
 
 lemma nterm_to_term_subst_replace_bound:
   assumes "closed u'" "n \<le> length \<Gamma>" "x \<notin> set (take n \<Gamma>)"
   shows "nterm_to_term \<Gamma> (subst_single u x u') = replace_bound n (nterm_to_term (insert_nth n x \<Gamma>) u) (nterm_to_term \<Gamma> u')"
 using assms
 proof (induction u arbitrary: n \<Gamma>)
   case (Nvar name)
   note insert_nth_take_drop[simp del]
   show ?case
     proof (cases "name = x")
       case True
       thus ?thesis
         using Nvar
         apply (simp add: find_first_insert_nth_eq)
         apply (subst incr_bounds_eq[where k = 0])
         subgoal by simp
         apply (rule nterm_to_term_closed_wellformed)
         by auto
     next
       case False
       thus ?thesis
         apply auto
         apply (subst find_first_insert_nth_neq)
         subgoal by simp
         by (cases "find_first name \<Gamma>") auto
     qed
 next
   case (Nabs y t)
   note insert_nth_take_drop[simp del]
   show ?case
     proof (cases "x = y")
       case True
       have "nterm_to_term (y # \<Gamma>) t = replace_bound (Suc n) (nterm_to_term (y # insert_nth n y \<Gamma>) t) (nterm_to_term \<Gamma> u')"
         proof (subst replace_bound_eq)
           show "Suc n |\<notin>| bounds (nterm_to_term (y # insert_nth n y \<Gamma>) t)"
             apply (rule nterm_to_term_bounds_dupl[where i = 0])
             subgoal by simp
             subgoal using Nabs(3) by (simp add: insert_nth_take_drop)
             subgoal by simp
             apply simp
             apply (subst nth_insert_nth_index_eq)
             using Nabs by auto
           show "nterm_to_term (y # \<Gamma>) t = incr_bounds (- 1) (Suc n + 1) (nterm_to_term (y # insert_nth n y \<Gamma>) t)"
             apply (subst nterm_to_term_insert_dupl[where \<Gamma> = "y # \<Gamma>" and y = y and n = "Suc n"])
             using Nabs by auto
         qed
       with True show ?thesis
         by auto
     next
       case False
       have "nterm_to_term (y # \<Gamma>) (subst_single t x u') = replace_bound (Suc n) (nterm_to_term (y # insert_nth n x \<Gamma>) t) (nterm_to_term \<Gamma> u')"
         apply (subst Nabs(1)[of "Suc n"])
         subgoal by fact
         subgoal using Nabs by simp
         subgoal using False Nabs by simp
         apply (subst nterm_to_term_eq_closed[where t = u'])
         using Nabs by auto
       with False show ?thesis
         by auto
     qed
 qed auto
 
 corollary nterm_to_term_subst_\<beta>:
   assumes "closed u'"
   shows "nterm_to_term \<Gamma> (subst u (fmap_of_list [(x, u')])) = nterm_to_term (x # \<Gamma>) u [nterm_to_term \<Gamma> u']\<^sub>\<beta>"
 using assms
 by (rule nterm_to_term_subst_replace_bound[where n = 0, simplified, unfolded subst_single_eq])
 
 end
\ No newline at end of file
diff --git a/thys/LTL/Disjunctive_Normal_Form.thy b/thys/LTL/Disjunctive_Normal_Form.thy
--- a/thys/LTL/Disjunctive_Normal_Form.thy
+++ b/thys/LTL/Disjunctive_Normal_Form.thy
@@ -1,1092 +1,1100 @@
 (*
     Author:   Benedikt Seidl
     Author:   Salomon Sickert
     License:  BSD
 *)
 
 section \<open>Disjunctive Normal Form of LTL formulas\<close>
 
 theory Disjunctive_Normal_Form
 imports
   LTL Equivalence_Relations "HOL-Library.FSet"
 begin
 
 text \<open>
   We use the propositional representation of LTL formulas to define
   the minimal disjunctive normal form of our formulas. For this purpose
   we define the minimal product \<open>\<otimes>\<^sub>m\<close> and union \<open>\<union>\<^sub>m\<close>.
   In the end we show that for a set \<open>\<A>\<close> of literals,
   @{term "\<A> \<Turnstile>\<^sub>P \<phi>"} if, and only if, there exists a subset
   of \<open>\<A>\<close> in the minimal DNF of \<open>\<phi>\<close>.
 \<close>
 
 subsection \<open>Definition of Minimum Sets\<close>
 
 definition (in ord) min_set :: "'a set \<Rightarrow> 'a set" where
   "min_set X = {y \<in> X. \<forall>x \<in> X. x \<le> y \<longrightarrow> x = y}"
 
 lemma min_set_iff:
   "x \<in> min_set X \<longleftrightarrow> x \<in> X \<and> (\<forall>y \<in> X. y \<le> x \<longrightarrow> y = x)"
   unfolding min_set_def by blast
 
 lemma min_set_subset:
   "min_set X \<subseteq> X"
   by (auto simp: min_set_def)
 
 lemma min_set_idem[simp]:
   "min_set (min_set X) = min_set X"
   by (auto simp: min_set_def)
 
 lemma min_set_empty[simp]:
   "min_set {} = {}"
   using min_set_subset by blast
 
 lemma min_set_singleton[simp]:
   "min_set {x} = {x}"
   by (auto simp: min_set_def)
 
 lemma min_set_finite:
   "finite X \<Longrightarrow> finite (min_set X)"
   by (simp add: min_set_def)
 
 lemma min_set_obtains_helper:
   "A \<in> B \<Longrightarrow> \<exists>C. C |\<subseteq>| A \<and> C \<in> min_set B"
 proof (induction "fcard A" arbitrary: A rule: less_induct)
   case less
 
   then have "(\<forall>A'. A' \<notin> B \<or> \<not> A' |\<subseteq>| A \<or> A' = A) \<or> (\<exists>A'. A' |\<subseteq>| A \<and> A' \<in> min_set B)"
     by (metis (no_types) dual_order.trans order.not_eq_order_implies_strict pfsubset_fcard_mono)
 
   then show ?case
     using less.prems min_set_def by auto
 qed
 
 lemma min_set_obtains:
   assumes "A \<in> B"
   obtains C where "C |\<subseteq>| A" and "C \<in> min_set B"
   using min_set_obtains_helper assms by metis
 
 
 
 subsection \<open>Minimal operators on sets\<close>
 
 definition product :: "'a fset set \<Rightarrow> 'a fset set \<Rightarrow> 'a fset set" (infixr "\<otimes>" 65)
   where "A \<otimes> B = {a |\<union>| b | a b. a \<in> A \<and> b \<in> B}"
 
 definition min_product :: "'a fset set \<Rightarrow> 'a fset set \<Rightarrow> 'a fset set" (infixr "\<otimes>\<^sub>m" 65)
   where "A \<otimes>\<^sub>m B = min_set (A \<otimes> B)"
 
 definition min_union :: "'a fset set \<Rightarrow> 'a fset set \<Rightarrow> 'a fset set" (infixr "\<union>\<^sub>m" 65)
   where "A \<union>\<^sub>m B = min_set (A \<union> B)"
 
 definition product_set :: "'a fset set set \<Rightarrow> 'a fset set" ("\<Otimes>")
   where "\<Otimes> X = Finite_Set.fold product {{||}} X"
 
 definition min_product_set :: "'a fset set set \<Rightarrow> 'a fset set" ("\<Otimes>\<^sub>m")
   where "\<Otimes>\<^sub>m X = Finite_Set.fold min_product {{||}} X"
 
 
 lemma min_product_idem[simp]:
   "A \<otimes>\<^sub>m A = min_set A"
   by (auto simp: min_product_def product_def min_set_def) fastforce
 
 lemma min_union_idem[simp]:
   "A \<union>\<^sub>m A = min_set A"
   by (simp add: min_union_def)
 
 
 lemma product_empty[simp]:
   "A \<otimes> {} = {}"
   "{} \<otimes> A = {}"
   by (simp_all add: product_def)
 
 lemma min_product_empty[simp]:
   "A \<otimes>\<^sub>m {} = {}"
   "{} \<otimes>\<^sub>m A = {}"
   by (simp_all add: min_product_def)
 
 lemma min_union_empty[simp]:
   "A \<union>\<^sub>m {} = min_set A"
   "{} \<union>\<^sub>m A = min_set A"
   by (simp_all add: min_union_def)
 
 lemma product_empty_singleton[simp]:
   "A \<otimes> {{||}} = A"
   "{{||}} \<otimes> A = A"
   by (simp_all add: product_def)
 
 lemma min_product_empty_singleton[simp]:
   "A \<otimes>\<^sub>m {{||}} = min_set A"
   "{{||}} \<otimes>\<^sub>m A = min_set A"
   by (simp_all add: min_product_def)
 
 lemma product_singleton_singleton:
   "A \<otimes> {{|x|}} = finsert x ` A"
   "{{|x|}} \<otimes> A = finsert x ` A"
   unfolding product_def by blast+
 
 lemma product_mono:
   "A \<subseteq> B \<Longrightarrow> A \<otimes> C \<subseteq> B \<otimes> C"
   "B \<subseteq> C \<Longrightarrow> A \<otimes> B \<subseteq> A \<otimes> C"
   unfolding product_def by auto
 
 
 
 lemma product_finite:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A \<otimes> B)"
   by (simp add: product_def finite_image_set2)
 
 lemma min_product_finite:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A \<otimes>\<^sub>m B)"
   by (metis min_product_def product_finite min_set_finite)
 
 lemma min_union_finite:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A \<union>\<^sub>m B)"
   by (simp add: min_union_def min_set_finite)
 
 
 lemma product_set_infinite[simp]:
   "infinite X \<Longrightarrow> \<Otimes> X = {{||}}"
   by (simp add: product_set_def)
 
 lemma min_product_set_infinite[simp]:
   "infinite X \<Longrightarrow> \<Otimes>\<^sub>m X = {{||}}"
   by (simp add: min_product_set_def)
 
 
 lemma product_comm:
   "A \<otimes> B = B \<otimes> A"
   unfolding product_def by blast
 
 lemma min_product_comm:
   "A \<otimes>\<^sub>m B = B \<otimes>\<^sub>m A"
   unfolding min_product_def
   by (simp add: product_comm)
 
 lemma min_union_comm:
   "A \<union>\<^sub>m B = B \<union>\<^sub>m A"
   unfolding min_union_def
   by (simp add: sup.commute)
 
 
 lemma product_iff:
   "x \<in> A \<otimes> B \<longleftrightarrow> (\<exists>a \<in> A. \<exists>b \<in> B. x = a |\<union>| b)"
   unfolding product_def by blast
 
 lemma min_product_iff:
   "x \<in> A \<otimes>\<^sub>m B \<longleftrightarrow> (\<exists>a \<in> A. \<exists>b \<in> B. x = a |\<union>| b) \<and> (\<forall>a \<in> A. \<forall>b \<in> B. a |\<union>| b |\<subseteq>| x \<longrightarrow> a |\<union>| b = x)"
   unfolding min_product_def min_set_iff product_iff product_def by blast
 
 lemma min_union_iff:
   "x \<in> A \<union>\<^sub>m B \<longleftrightarrow> x \<in> A \<union> B \<and> (\<forall>a \<in> A. a |\<subseteq>| x \<longrightarrow> a = x) \<and> (\<forall>b \<in> B. b |\<subseteq>| x \<longrightarrow> b = x)"
   unfolding min_union_def min_set_iff by blast
 
 
 lemma min_set_min_product_helper:
   "x \<in> (min_set A) \<otimes>\<^sub>m B \<longleftrightarrow> x \<in> A \<otimes>\<^sub>m B"
 proof
   fix x
   assume "x \<in> (min_set A) \<otimes>\<^sub>m B"
 
   then obtain a b where "a \<in> min_set A" and "b \<in> B" and "x = a |\<union>| b" and 1: "\<forall>a \<in> min_set A. \<forall>b \<in> B. a |\<union>| b |\<subseteq>| x \<longrightarrow> a |\<union>| b = x"
     unfolding min_product_iff by blast
 
   moreover
 
   {
     fix a' b'
     assume "a' \<in> A" and "b' \<in> B" and "a' |\<union>| b' |\<subseteq>| x"
 
     then obtain a'' where "a'' |\<subseteq>| a'" and "a'' \<in> min_set A"
       using min_set_obtains by metis
 
     then have "a'' |\<union>| b' = x"
       by (metis (full_types) 1 \<open>b' \<in> B\<close> \<open>a' |\<union>| b' |\<subseteq>| x\<close> dual_order.trans le_sup_iff)
 
     then have "a' |\<union>| b' = x"
       using \<open>a' |\<union>| b' |\<subseteq>| x\<close> \<open>a'' |\<subseteq>| a'\<close> by blast
   }
 
   ultimately show "x \<in> A \<otimes>\<^sub>m B"
     by (metis min_product_iff min_set_iff)
 next
   fix x
   assume "x \<in> A \<otimes>\<^sub>m B"
 
   then have 1: "x \<in> A \<otimes> B" and "\<forall>y \<in> A \<otimes> B. y |\<subseteq>| x \<longrightarrow> y = x"
     unfolding min_product_def min_set_iff by simp+
 
   then have 2: "\<forall>y\<in>min_set A \<otimes> B. y |\<subseteq>| x \<longrightarrow> y = x"
     by (metis product_iff min_set_iff)
 
   then have "x \<in> min_set A \<otimes> B"
     by (metis 1 funion_mono min_set_obtains order_refl product_iff)
 
   then show "x \<in> min_set A \<otimes>\<^sub>m B"
     by (simp add: 2 min_product_def min_set_iff)
 qed
 
 lemma min_set_min_product[simp]:
   "(min_set A) \<otimes>\<^sub>m B = A \<otimes>\<^sub>m B"
   "A \<otimes>\<^sub>m (min_set B) = A \<otimes>\<^sub>m B"
   using min_product_comm min_set_min_product_helper by blast+
 
 lemma min_set_min_union[simp]:
   "(min_set A) \<union>\<^sub>m B = A \<union>\<^sub>m B"
   "A \<union>\<^sub>m (min_set B) = A \<union>\<^sub>m B"
 proof (unfold min_union_def min_set_def, safe)
   show "\<And>x xa xb. \<lbrakk>\<forall>xa\<in>{y \<in> A. \<forall>x\<in>A. x |\<subseteq>| y \<longrightarrow> x = y} \<union> B. xa |\<subseteq>| x \<longrightarrow> xa = x; x \<in> B; xa |\<subseteq>| x; xb |\<in>| x; xa \<in> A\<rbrakk> \<Longrightarrow> xb |\<in>| xa"
     by (metis (mono_tags) UnCI dual_order.trans fequalityI min_set_def min_set_obtains)
 next
   show "\<And>x xa xb. \<lbrakk>\<forall>xa\<in>A \<union> {y \<in> B. \<forall>x\<in>B. x |\<subseteq>| y \<longrightarrow> x = y}. xa |\<subseteq>| x \<longrightarrow> xa = x; x \<in> A; xa |\<subseteq>| x; xb |\<in>| x; xa \<in> B\<rbrakk> \<Longrightarrow> xb |\<in>| xa"
     by (metis (mono_tags) UnCI dual_order.trans fequalityI min_set_def min_set_obtains)
 qed blast+
 
 
 lemma product_assoc[simp]:
   "(A \<otimes> B) \<otimes> C = A \<otimes> (B \<otimes> C)"
 proof (unfold product_def, safe)
   fix a b c
   assume "a \<in> A" and "c \<in> C" and "b \<in> B"
   then have "b |\<union>| c \<in> {b |\<union>| c |b c. b \<in> B \<and> c \<in> C}"
     by blast
   then show "\<exists>a' bc. a |\<union>| b |\<union>| c = a' |\<union>| bc \<and> a' \<in> A \<and> bc \<in> {b |\<union>| c |b c. b \<in> B \<and> c \<in> C}"
     using \<open>a \<in> A\<close> by (metis (no_types) inf_sup_aci(5) sup_left_commute)
 qed (metis (mono_tags, lifting) mem_Collect_eq sup_assoc)
 
 lemma min_product_assoc[simp]:
   "(A \<otimes>\<^sub>m B) \<otimes>\<^sub>m C = A \<otimes>\<^sub>m (B \<otimes>\<^sub>m C)"
   unfolding min_product_def[of A B] min_product_def[of B C]
   by simp (simp add: min_product_def)
 
 lemma min_union_assoc[simp]:
   "(A \<union>\<^sub>m B) \<union>\<^sub>m C = A \<union>\<^sub>m (B \<union>\<^sub>m C)"
   unfolding min_union_def[of A B] min_union_def[of B C]
   by simp (simp add: min_union_def sup_assoc)
 
 
 lemma min_product_comp:
   "a \<in> A \<Longrightarrow> b \<in> B \<Longrightarrow> \<exists>c. c |\<subseteq>| (a |\<union>| b) \<and> c \<in> A \<otimes>\<^sub>m B"
   by (metis (mono_tags, lifting) mem_Collect_eq min_product_def product_def min_set_obtains)
 
 lemma min_union_comp:
   "a \<in> A \<Longrightarrow> \<exists>c. c |\<subseteq>| a \<and> c \<in> A \<union>\<^sub>m B"
   by (metis Un_iff min_set_obtains min_union_def)
 
 
 interpretation product_set_thms: Finite_Set.comp_fun_commute product
 proof unfold_locales
   have "\<And>x y z. x \<otimes> (y \<otimes> z) = y \<otimes> (x \<otimes> z)"
     by (simp only: product_assoc[symmetric]) (simp only: product_comm)
 
   then show "\<And>x y. (\<otimes>) y \<circ> (\<otimes>) x = (\<otimes>) x \<circ> (\<otimes>) y"
     by fastforce
 qed
 
 interpretation min_product_set_thms: Finite_Set.comp_fun_idem min_product
 proof unfold_locales
   have "\<And>x y z. x \<otimes>\<^sub>m (y \<otimes>\<^sub>m z) = y \<otimes>\<^sub>m (x \<otimes>\<^sub>m z)"
     by (simp only: min_product_assoc[symmetric]) (simp only: min_product_comm)
 
   then show "\<And>x y. (\<otimes>\<^sub>m) y \<circ> (\<otimes>\<^sub>m) x = (\<otimes>\<^sub>m) x \<circ> (\<otimes>\<^sub>m) y"
     by fastforce
 next
   have "\<And>x y. x \<otimes>\<^sub>m (x \<otimes>\<^sub>m y) = x \<otimes>\<^sub>m y"
     by (simp add: min_product_assoc[symmetric])
 
   then show "\<And>x. (\<otimes>\<^sub>m) x \<circ> (\<otimes>\<^sub>m) x = (\<otimes>\<^sub>m) x"
     by fastforce
 qed
 
 
 interpretation min_union_set_thms: Finite_Set.comp_fun_idem min_union
 proof unfold_locales
   have "\<And>x y z. x \<union>\<^sub>m (y \<union>\<^sub>m z) = y \<union>\<^sub>m (x \<union>\<^sub>m z)"
     by (simp only: min_union_assoc[symmetric]) (simp only: min_union_comm)
 
   then show "\<And>x y. (\<union>\<^sub>m) y \<circ> (\<union>\<^sub>m) x = (\<union>\<^sub>m) x \<circ> (\<union>\<^sub>m) y"
     by fastforce
 next
   have "\<And>x y. x \<union>\<^sub>m (x \<union>\<^sub>m y) = x \<union>\<^sub>m y"
     by (simp add: min_union_assoc[symmetric])
 
   then show "\<And>x. (\<union>\<^sub>m) x \<circ> (\<union>\<^sub>m) x = (\<union>\<^sub>m) x"
     by fastforce
 qed
 
 
 lemma product_set_empty[simp]:
   "\<Otimes> {} = {{||}}"
   "\<Otimes> {{}} = {}"
   "\<Otimes> {{{||}}} = {{||}}"
   by (simp_all add: product_set_def)
 
 lemma min_product_set_empty[simp]:
   "\<Otimes>\<^sub>m {} = {{||}}"
   "\<Otimes>\<^sub>m {{}} = {}"
   "\<Otimes>\<^sub>m {{{||}}} = {{||}}"
   by (simp_all add: min_product_set_def)
 
 lemma product_set_code[code]:
   "\<Otimes> (set xs) = fold product (remdups xs) {{||}}"
   by (simp add: product_set_def product_set_thms.fold_set_fold_remdups)
 
 lemma min_product_set_code[code]:
   "\<Otimes>\<^sub>m (set xs) = fold min_product (remdups xs) {{||}}"
   by (simp add: min_product_set_def min_product_set_thms.fold_set_fold_remdups)
 
 lemma product_set_insert[simp]:
   "finite X \<Longrightarrow> \<Otimes> (insert x X) = x \<otimes> (\<Otimes> (X - {x}))"
   unfolding product_set_def product_set_thms.fold_insert_remove ..
 
 lemma min_product_set_insert[simp]:
   "finite X \<Longrightarrow> \<Otimes>\<^sub>m (insert x X) = x \<otimes>\<^sub>m (\<Otimes>\<^sub>m X)"
   unfolding min_product_set_def min_product_set_thms.fold_insert_idem ..
 
 lemma min_product_subseteq:
   "x \<in> A \<otimes>\<^sub>m B \<Longrightarrow> \<exists>a. a |\<subseteq>| x \<and> a \<in> A"
   by (metis funion_upper1 min_product_iff)
 
 lemma min_product_set_subseteq:
   "finite X \<Longrightarrow> x \<in> \<Otimes>\<^sub>m X \<Longrightarrow> A \<in> X \<Longrightarrow> \<exists>a \<in> A. a |\<subseteq>| x"
   by (induction X rule: finite_induct) (blast, metis finite_insert insert_absorb min_product_set_insert min_product_subseteq)
 
 lemma min_set_product_set:
   "\<Otimes>\<^sub>m A = min_set (\<Otimes> A)"
   by (cases "finite A", induction A rule: finite_induct) (simp_all add: min_product_set_def product_set_def, metis min_product_def)
 
 
 lemma min_product_min_set[simp]:
   "min_set (A \<otimes>\<^sub>m B) = A \<otimes>\<^sub>m B"
   by (simp add: min_product_def)
 
 lemma min_union_min_set[simp]:
   "min_set (A \<union>\<^sub>m B) = A \<union>\<^sub>m B"
   by (simp add: min_union_def)
 
 lemma min_product_set_min_set[simp]:
   "finite X \<Longrightarrow> min_set (\<Otimes>\<^sub>m X) = \<Otimes>\<^sub>m X"
   by (induction X rule: finite_induct, auto simp add: min_product_set_def min_set_iff)
 
 lemma min_set_min_product_set[simp]:
   "finite X \<Longrightarrow> \<Otimes>\<^sub>m (min_set ` X) = \<Otimes>\<^sub>m X"
   by (induction X rule: finite_induct) simp_all
 
 lemma min_product_set_union[simp]:
   "finite X \<Longrightarrow> finite Y \<Longrightarrow> \<Otimes>\<^sub>m (X \<union> Y) = (\<Otimes>\<^sub>m X) \<otimes>\<^sub>m (\<Otimes>\<^sub>m Y)"
   by (induction X rule: finite_induct) simp_all
 
 
 lemma product_set_finite:
   "(\<And>x. x \<in> X \<Longrightarrow> finite x) \<Longrightarrow> finite (\<Otimes> X)"
   by (cases "finite X", rotate_tac, induction X rule: finite_induct) (simp_all add: product_set_def, insert product_finite, blast)
 
 lemma min_product_set_finite:
   "(\<And>x. x \<in> X \<Longrightarrow> finite x) \<Longrightarrow> finite (\<Otimes>\<^sub>m X)"
   by (cases "finite X", rotate_tac, induction X rule: finite_induct) (simp_all add: min_product_set_def, insert min_product_finite, blast)
 
 
 
 subsection \<open>Disjunctive Normal Form\<close>
 
 fun dnf :: "'a ltln \<Rightarrow> 'a ltln fset set"
 where
   "dnf true\<^sub>n = {{||}}"
 | "dnf false\<^sub>n = {}"
 | "dnf (\<phi> and\<^sub>n \<psi>) = (dnf \<phi>) \<otimes> (dnf \<psi>)"
 | "dnf (\<phi> or\<^sub>n \<psi>) = (dnf \<phi>) \<union> (dnf \<psi>)"
 | "dnf \<phi> = {{|\<phi>|}}"
 
 fun min_dnf :: "'a ltln \<Rightarrow> 'a ltln fset set"
 where
   "min_dnf true\<^sub>n = {{||}}"
 | "min_dnf false\<^sub>n = {}"
 | "min_dnf (\<phi> and\<^sub>n \<psi>) = (min_dnf \<phi>) \<otimes>\<^sub>m (min_dnf \<psi>)"
 | "min_dnf (\<phi> or\<^sub>n \<psi>) = (min_dnf \<phi>) \<union>\<^sub>m (min_dnf \<psi>)"
 | "min_dnf \<phi> = {{|\<phi>|}}"
 
 lemma dnf_min_set:
   "min_dnf \<phi> = min_set (dnf \<phi>)"
   by (induction \<phi>) (simp_all, simp_all only: min_product_def min_union_def)
 
 lemma dnf_finite:
   "finite (dnf \<phi>)"
   by (induction \<phi>) (auto simp: product_finite)
 
 lemma min_dnf_finite:
   "finite (min_dnf \<phi>)"
   by (induction \<phi>) (auto simp: min_product_finite min_union_finite)
 
 lemma dnf_Abs_fset[simp]:
   "fset (Abs_fset (dnf \<phi>)) = dnf \<phi>"
   by (simp add: dnf_finite Abs_fset_inverse)
 
 lemma min_dnf_Abs_fset[simp]:
   "fset (Abs_fset (min_dnf \<phi>)) = min_dnf \<phi>"
   by (simp add: min_dnf_finite Abs_fset_inverse)
 
 lemma dnf_prop_atoms:
   "\<Phi> \<in> dnf \<phi> \<Longrightarrow> fset \<Phi> \<subseteq> prop_atoms \<phi>"
   by (induction \<phi> arbitrary: \<Phi>) (auto simp: product_def)
 
 lemma min_dnf_prop_atoms:
   "\<Phi> \<in> min_dnf \<phi> \<Longrightarrow> fset \<Phi> \<subseteq> prop_atoms \<phi>"
   using dnf_min_set dnf_prop_atoms min_set_subset by blast
 
 lemma min_dnf_atoms_dnf:
   "\<Phi> \<in> min_dnf \<psi> \<Longrightarrow> \<phi> \<in> fset \<Phi> \<Longrightarrow> dnf \<phi> = {{|\<phi>|}}"
 proof (induction \<phi>)
   case True_ltln
   then show ?case
     using min_dnf_prop_atoms prop_atoms_notin(1) by blast
 next
   case False_ltln
   then show ?case
     using min_dnf_prop_atoms prop_atoms_notin(2) by blast
 next
   case (And_ltln \<phi>1 \<phi>2)
   then show ?case
     using min_dnf_prop_atoms prop_atoms_notin(3) by force
 next
   case (Or_ltln \<phi>1 \<phi>2)
   then show ?case
     using min_dnf_prop_atoms prop_atoms_notin(4) by force
 qed auto
 
 lemma min_dnf_min_set[simp]:
   "min_set (min_dnf \<phi>) = min_dnf \<phi>"
   by (induction \<phi>) (simp_all add: min_set_def min_product_def min_union_def, blast+)
 
 
 lemma min_dnf_iff_prop_assignment_subset:
   "\<A> \<Turnstile>\<^sub>P \<phi> \<longleftrightarrow> (\<exists>B. fset B \<subseteq> \<A> \<and> B \<in> min_dnf \<phi>)"
 proof
   assume "\<A> \<Turnstile>\<^sub>P \<phi>"
 
   then show "\<exists>B. fset B \<subseteq> \<A> \<and> B \<in> min_dnf \<phi>"
   proof (induction \<phi> arbitrary: \<A>)
     case (And_ltln \<phi>\<^sub>1 \<phi>\<^sub>2)
 
     then obtain B\<^sub>1 B\<^sub>2 where 1: "fset B\<^sub>1 \<subseteq> \<A> \<and> B\<^sub>1 \<in> min_dnf \<phi>\<^sub>1" and 2: "fset B\<^sub>2 \<subseteq> \<A> \<and> B\<^sub>2 \<in> min_dnf \<phi>\<^sub>2"
       by fastforce
 
     then obtain C where "C |\<subseteq>| B\<^sub>1 |\<union>| B\<^sub>2" and "C \<in> min_dnf \<phi>\<^sub>1 \<otimes>\<^sub>m min_dnf \<phi>\<^sub>2"
       using min_product_comp by metis
 
     then show ?case
       by (metis 1 2 le_sup_iff min_dnf.simps(3) sup.absorb_iff1 sup_fset.rep_eq)
   next
     case (Or_ltln \<phi>\<^sub>1 \<phi>\<^sub>2)
 
     {
       assume "\<A> \<Turnstile>\<^sub>P \<phi>\<^sub>1"
 
       then obtain B where 1: "fset B \<subseteq> \<A> \<and> B \<in> min_dnf \<phi>\<^sub>1"
         using Or_ltln by fastforce
 
       then obtain C where "C |\<subseteq>| B" and "C \<in> min_dnf \<phi>\<^sub>1 \<union>\<^sub>m min_dnf \<phi>\<^sub>2"
         using min_union_comp by metis
 
       then have ?case
         by (metis 1 dual_order.trans less_eq_fset.rep_eq min_dnf.simps(4))
     }
 
     moreover
 
     {
       assume "\<A> \<Turnstile>\<^sub>P \<phi>\<^sub>2"
 
       then obtain B where 2: "fset B \<subseteq> \<A> \<and> B \<in> min_dnf \<phi>\<^sub>2"
         using Or_ltln by fastforce
 
       then obtain C where "C |\<subseteq>| B" and "C \<in> min_dnf \<phi>\<^sub>1 \<union>\<^sub>m min_dnf \<phi>\<^sub>2"
         using min_union_comp min_union_comm by metis
 
       then have ?case
         by (metis 2 dual_order.trans less_eq_fset.rep_eq min_dnf.simps(4))
     }
 
     ultimately show ?case
       using Or_ltln.prems by auto
   qed simp_all
 next
   assume "\<exists>B. fset B \<subseteq> \<A> \<and> B \<in> min_dnf \<phi>"
 
   then obtain B where "fset B \<subseteq> \<A>" and "B \<in> min_dnf \<phi>"
     by auto
 
   then have "fset B \<Turnstile>\<^sub>P \<phi>"
     by (induction \<phi> arbitrary: B) (auto simp: min_set_def min_product_def product_def min_union_def)
 
   then show "\<A> \<Turnstile>\<^sub>P \<phi>"
     using \<open>fset B \<subseteq> \<A>\<close> by blast
 qed
 
 
 lemma ltl_prop_implies_min_dnf:
   "\<phi> \<longrightarrow>\<^sub>P \<psi> = (\<forall>A \<in> min_dnf \<phi>. \<exists>B \<in> min_dnf \<psi>. B |\<subseteq>| A)"
   by (meson less_eq_fset.rep_eq ltl_prop_implies_def min_dnf_iff_prop_assignment_subset order_refl dual_order.trans)
 
 lemma ltl_prop_equiv_min_dnf:
   "\<phi> \<sim>\<^sub>P \<psi> = (min_dnf \<phi> = min_dnf \<psi>)"
 proof
   assume "\<phi> \<sim>\<^sub>P \<psi>"
 
   then have "\<And>x. x \<in> min_set (min_dnf \<phi>) \<longleftrightarrow> x \<in> min_set (min_dnf \<psi>)"
     unfolding ltl_prop_implies_equiv ltl_prop_implies_min_dnf min_set_iff
     by fastforce
 
   then show "min_dnf \<phi> = min_dnf \<psi>"
     by auto
 qed (simp add: ltl_prop_equiv_def min_dnf_iff_prop_assignment_subset)
 
 lemma min_dnf_rep_abs[simp]:
   "min_dnf (rep_ltln\<^sub>P (abs_ltln\<^sub>P \<phi>)) = min_dnf \<phi>"
   by (simp add: ltl_prop_equiv_min_dnf[symmetric] Quotient3_ltln\<^sub>P rep_abs_rsp_left)
 
 
 subsection \<open>Folding of \<open>and\<^sub>n\<close> and \<open>or\<^sub>n\<close> over Finite Sets\<close>
 
 definition And\<^sub>n :: "'a ltln set \<Rightarrow> 'a ltln"
 where
   "And\<^sub>n \<Phi> \<equiv> SOME \<phi>. fold_graph And_ltln True_ltln \<Phi> \<phi>"
 
 definition Or\<^sub>n :: "'a ltln set \<Rightarrow> 'a ltln"
 where
   "Or\<^sub>n \<Phi> \<equiv> SOME \<phi>. fold_graph Or_ltln False_ltln \<Phi> \<phi>"
 
 lemma fold_graph_And\<^sub>n:
   "finite \<Phi> \<Longrightarrow> fold_graph And_ltln True_ltln \<Phi> (And\<^sub>n \<Phi>)"
   unfolding And\<^sub>n_def by (rule someI2_ex[OF finite_imp_fold_graph])
 
 lemma fold_graph_Or\<^sub>n:
   "finite \<Phi> \<Longrightarrow> fold_graph Or_ltln False_ltln \<Phi> (Or\<^sub>n \<Phi>)"
   unfolding Or\<^sub>n_def by (rule someI2_ex[OF finite_imp_fold_graph])
 
 lemma Or\<^sub>n_empty[simp]:
   "Or\<^sub>n {} = False_ltln"
   by (metis empty_fold_graphE finite.emptyI fold_graph_Or\<^sub>n)
 
 lemma And\<^sub>n_empty[simp]:
   "And\<^sub>n {} = True_ltln"
   by (metis empty_fold_graphE finite.emptyI fold_graph_And\<^sub>n)
 
 interpretation dnf_union_thms: Finite_Set.comp_fun_commute "\<lambda>\<phi>. (\<union>) (f \<phi>)"
   by unfold_locales fastforce
 
 interpretation dnf_product_thms: Finite_Set.comp_fun_commute "\<lambda>\<phi>. (\<otimes>) (f \<phi>)"
   by unfold_locales (simp add: product_set_thms.comp_fun_commute)
 
 \<comment> \<open>Copied from locale @{locale comp_fun_commute}\<close>
 lemma fold_graph_finite:
   assumes "fold_graph f z A y"
   shows "finite A"
   using assms by induct simp_all
 
 
 text \<open>Taking the DNF of @{const And\<^sub>n} and @{const Or\<^sub>n} is the same as folding over the individual DNFs.\<close>
 
 lemma And\<^sub>n_dnf:
   "finite \<Phi> \<Longrightarrow> dnf (And\<^sub>n \<Phi>) = Finite_Set.fold (\<lambda>\<phi>. (\<otimes>) (dnf \<phi>)) {{||}} \<Phi>"
 proof (drule fold_graph_And\<^sub>n, induction rule: fold_graph.induct)
   case (insertI x A y)
 
   then have "finite A"
     using fold_graph_finite by fast
 
   then show ?case
     using insertI by auto
 qed simp
 
 lemma Or\<^sub>n_dnf:
   "finite \<Phi> \<Longrightarrow> dnf (Or\<^sub>n \<Phi>) = Finite_Set.fold (\<lambda>\<phi>. (\<union>) (dnf \<phi>)) {} \<Phi>"
 proof (drule fold_graph_Or\<^sub>n, induction rule: fold_graph.induct)
   case (insertI x A y)
 
   then have "finite A"
     using fold_graph_finite by fast
 
   then show ?case
     using insertI by auto
 qed simp
 
 
 text \<open>@{const And\<^sub>n} and @{const Or\<^sub>n} are injective on finite sets.\<close>
 
 lemma And\<^sub>n_inj:
   "inj_on And\<^sub>n {s. finite s}"
 proof (standard, simp)
   fix x y :: "'a ltln set"
   assume "finite x" and "finite y"
 
   then have 1: "fold_graph And_ltln True_ltln x (And\<^sub>n x)" and 2: "fold_graph And_ltln True_ltln y (And\<^sub>n y)"
     using fold_graph_And\<^sub>n by blast+
 
   assume "And\<^sub>n x = And\<^sub>n y"
 
   with 1 show "x = y"
   proof (induction rule: fold_graph.induct)
     case emptyI
     then show ?case
       using 2 fold_graph.cases by force
   next
     case (insertI x A y)
     with 2 show ?case
     proof (induction arbitrary: x A y rule: fold_graph.induct)
       case (insertI x A y)
       then show ?case
         by (metis fold_graph.cases insertI1 ltln.distinct(7) ltln.inject(3))
     qed blast
   qed
 qed
 
 lemma Or\<^sub>n_inj:
   "inj_on Or\<^sub>n {s. finite s}"
 proof (standard, simp)
   fix x y :: "'a ltln set"
   assume "finite x" and "finite y"
 
   then have 1: "fold_graph Or_ltln False_ltln x (Or\<^sub>n x)" and 2: "fold_graph Or_ltln False_ltln y (Or\<^sub>n y)"
     using fold_graph_Or\<^sub>n by blast+
 
   assume "Or\<^sub>n x = Or\<^sub>n y"
 
   with 1 show "x = y"
   proof (induction rule: fold_graph.induct)
     case emptyI
     then show ?case
       using 2 fold_graph.cases by force
   next
     case (insertI x A y)
     with 2 show ?case
     proof (induction arbitrary: x A y rule: fold_graph.induct)
       case (insertI x A y)
       then show ?case
         by (metis fold_graph.cases insertI1 ltln.distinct(27) ltln.inject(4))
     qed blast
   qed
 qed
 
 
 text \<open>The semantics of @{const And\<^sub>n} and @{const Or\<^sub>n} can be expressed using quantifiers.\<close>
 
 lemma And\<^sub>n_semantics:
   "finite \<Phi> \<Longrightarrow> w \<Turnstile>\<^sub>n And\<^sub>n \<Phi> \<longleftrightarrow> (\<forall>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
 proof -
   assume "finite \<Phi>"
   have "\<And>\<psi>. fold_graph And_ltln True_ltln \<Phi> \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<psi> \<longleftrightarrow> (\<forall>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
     by (rule fold_graph.induct) auto
   then show ?thesis
     using fold_graph_And\<^sub>n[OF \<open>finite \<Phi>\<close>] by simp
 qed
 
 lemma Or\<^sub>n_semantics:
   "finite \<Phi> \<Longrightarrow> w \<Turnstile>\<^sub>n Or\<^sub>n \<Phi> \<longleftrightarrow> (\<exists>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
 proof -
   assume "finite \<Phi>"
   have "\<And>\<psi>. fold_graph Or_ltln False_ltln \<Phi> \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<psi> \<longleftrightarrow> (\<exists>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
     by (rule fold_graph.induct) auto
   then show ?thesis
     using fold_graph_Or\<^sub>n[OF \<open>finite \<Phi>\<close>] by simp
 qed
 
 lemma And\<^sub>n_prop_semantics:
   "finite \<Phi> \<Longrightarrow> \<A> \<Turnstile>\<^sub>P And\<^sub>n \<Phi> \<longleftrightarrow> (\<forall>\<phi> \<in> \<Phi>. \<A> \<Turnstile>\<^sub>P \<phi>)"
 proof -
   assume "finite \<Phi>"
   have "\<And>\<psi>. fold_graph And_ltln True_ltln \<Phi> \<psi> \<Longrightarrow> \<A> \<Turnstile>\<^sub>P \<psi> \<longleftrightarrow> (\<forall>\<phi> \<in> \<Phi>. \<A> \<Turnstile>\<^sub>P \<phi>)"
     by (rule fold_graph.induct) auto
   then show ?thesis
     using fold_graph_And\<^sub>n[OF \<open>finite \<Phi>\<close>] by simp
 qed
 
 lemma Or\<^sub>n_prop_semantics:
   "finite \<Phi> \<Longrightarrow> \<A> \<Turnstile>\<^sub>P Or\<^sub>n \<Phi> \<longleftrightarrow> (\<exists>\<phi> \<in> \<Phi>. \<A> \<Turnstile>\<^sub>P \<phi>)"
 proof -
   assume "finite \<Phi>"
   have "\<And>\<psi>. fold_graph Or_ltln False_ltln \<Phi> \<psi> \<Longrightarrow> \<A> \<Turnstile>\<^sub>P \<psi> \<longleftrightarrow> (\<exists>\<phi> \<in> \<Phi>. \<A> \<Turnstile>\<^sub>P \<phi>)"
     by (rule fold_graph.induct) auto
   then show ?thesis
     using fold_graph_Or\<^sub>n[OF \<open>finite \<Phi>\<close>] by simp
 qed
 
 lemma Or\<^sub>n_And\<^sub>n_image_semantics:
   assumes "finite \<A>" and "\<And>\<Phi>. \<Phi> \<in> \<A> \<Longrightarrow> finite \<Phi>"
   shows "w \<Turnstile>\<^sub>n Or\<^sub>n (And\<^sub>n ` \<A>) \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. \<forall>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
 proof -
   have "w \<Turnstile>\<^sub>n Or\<^sub>n (And\<^sub>n ` \<A>) \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. w \<Turnstile>\<^sub>n And\<^sub>n \<Phi>)"
     using Or\<^sub>n_semantics assms by auto
   then show ?thesis
     using And\<^sub>n_semantics assms by fast
 qed
 
 lemma Or\<^sub>n_And\<^sub>n_image_prop_semantics:
   assumes "finite \<A>" and "\<And>\<Phi>. \<Phi> \<in> \<A> \<Longrightarrow> finite \<Phi>"
   shows "\<I> \<Turnstile>\<^sub>P Or\<^sub>n (And\<^sub>n ` \<A>) \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. \<forall>\<phi> \<in> \<Phi>. \<I> \<Turnstile>\<^sub>P \<phi>)"
 proof -
   have "\<I> \<Turnstile>\<^sub>P Or\<^sub>n (And\<^sub>n ` \<A>) \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. \<I> \<Turnstile>\<^sub>P And\<^sub>n \<Phi>)"
     using Or\<^sub>n_prop_semantics assms by blast
   then show ?thesis
     using And\<^sub>n_prop_semantics assms by metis
 qed
 
 
 subsection \<open>DNF to LTL conversion\<close>
 
 definition ltln_of_dnf :: "'a ltln fset set \<Rightarrow> 'a ltln"
 where
   "ltln_of_dnf \<A> = Or\<^sub>n (And\<^sub>n ` fset ` \<A>)"
 
 lemma ltln_of_dnf_semantics:
   assumes "finite \<A>"
   shows "w \<Turnstile>\<^sub>n ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. \<forall>\<phi>. \<phi> |\<in>| \<Phi> \<longrightarrow> w \<Turnstile>\<^sub>n \<phi>)"
 proof -
-  have "finite (fset ` \<A>)"
-    using assms by blast
-
-  then have "w \<Turnstile>\<^sub>n ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> fset ` \<A>. \<forall>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
-    unfolding ltln_of_dnf_def using Or\<^sub>n_And\<^sub>n_image_semantics by fastforce
+  have "w \<Turnstile>\<^sub>n ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> fset ` \<A>. \<forall>\<phi> \<in> \<Phi>. w \<Turnstile>\<^sub>n \<phi>)"
+    unfolding ltln_of_dnf_def
+  proof (rule Or\<^sub>n_And\<^sub>n_image_semantics)
+    show "finite (fset ` \<A>)"
+      using assms by blast
+  next
+    show "\<And>\<Phi>. \<Phi> \<in> fset ` \<A> \<Longrightarrow> finite \<Phi>"
+      by auto
+  qed
 
   then show ?thesis
     by (metis image_iff)
 qed
 
 lemma ltln_of_dnf_prop_semantics:
   assumes "finite \<A>"
   shows "\<I> \<Turnstile>\<^sub>P ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> \<A>. \<forall>\<phi>. \<phi> |\<in>| \<Phi> \<longrightarrow> \<I> \<Turnstile>\<^sub>P \<phi>)"
 proof -
-  have "finite (fset ` \<A>)"
-    using assms by blast
-
-  then have "\<I> \<Turnstile>\<^sub>P ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> fset ` \<A>. \<forall>\<phi> \<in> \<Phi>. \<I> \<Turnstile>\<^sub>P \<phi>)"
-    unfolding ltln_of_dnf_def using Or\<^sub>n_And\<^sub>n_image_prop_semantics by fastforce
+  have "\<I> \<Turnstile>\<^sub>P ltln_of_dnf \<A> \<longleftrightarrow> (\<exists>\<Phi> \<in> fset ` \<A>. \<forall>\<phi> \<in> \<Phi>. \<I> \<Turnstile>\<^sub>P \<phi>)"
+    unfolding ltln_of_dnf_def
+  proof (rule Or\<^sub>n_And\<^sub>n_image_prop_semantics)
+    show "finite (fset ` \<A>)"
+      using assms by blast
+  next
+    show "\<And>\<Phi>. \<Phi> \<in> fset ` \<A> \<Longrightarrow> finite \<Phi>"
+      by auto
+  qed
 
   then show ?thesis
     by (metis image_iff)
 qed
 
 lemma ltln_of_dnf_prop_equiv:
   "ltln_of_dnf (min_dnf \<phi>) \<sim>\<^sub>P \<phi>"
   unfolding ltl_prop_equiv_def
 proof
   fix \<A>
   have "\<A> \<Turnstile>\<^sub>P ltln_of_dnf (min_dnf \<phi>) \<longleftrightarrow> (\<exists>\<Phi> \<in> min_dnf \<phi>. \<forall>\<phi>. \<phi> |\<in>| \<Phi> \<longrightarrow> \<A> \<Turnstile>\<^sub>P \<phi>)"
     using ltln_of_dnf_prop_semantics min_dnf_finite by metis
   also have "\<dots> \<longleftrightarrow> (\<exists>\<Phi> \<in> min_dnf \<phi>. fset \<Phi> \<subseteq> \<A>)"
     by (metis min_dnf_prop_atoms prop_atoms_entailment_iff subset_eq)
   also have "\<dots> \<longleftrightarrow> \<A> \<Turnstile>\<^sub>P \<phi>"
     using min_dnf_iff_prop_assignment_subset by blast
   finally show "\<A> \<Turnstile>\<^sub>P ltln_of_dnf (min_dnf \<phi>) = \<A> \<Turnstile>\<^sub>P \<phi>" .
 qed
 
 lemma min_dnf_ltln_of_dnf[simp]:
   "min_dnf (ltln_of_dnf (min_dnf \<phi>)) = min_dnf \<phi>"
   using ltl_prop_equiv_min_dnf ltln_of_dnf_prop_equiv by blast
 
 
 subsection \<open>Substitution in DNF formulas\<close>
 
 definition subst_clause :: "'a ltln fset \<Rightarrow> ('a ltln \<rightharpoonup> 'a ltln) \<Rightarrow> 'a ltln fset set"
 where
   "subst_clause \<Phi> m = \<Otimes>\<^sub>m {min_dnf (subst \<phi> m) | \<phi>. \<phi> \<in> fset \<Phi>}"
 
 definition subst_dnf :: "'a ltln fset set \<Rightarrow> ('a ltln \<rightharpoonup> 'a ltln) \<Rightarrow> 'a ltln fset set"
 where
   "subst_dnf \<A> m = (\<Union>\<Phi> \<in> \<A>. subst_clause \<Phi> m)"
 
 lemma subst_clause_empty[simp]:
   "subst_clause {||} m = {{||}}"
   by (simp add: subst_clause_def)
 
 lemma subst_dnf_empty[simp]:
   "subst_dnf {} m = {}"
   by (simp add: subst_dnf_def)
 
 lemma subst_clause_inner_finite:
   "finite {min_dnf (subst \<phi> m) | \<phi>. \<phi> \<in> \<Phi>}" if "finite \<Phi>"
   using that by simp
 
 lemma subst_clause_finite:
   "finite (subst_clause \<Phi> m)"
   unfolding subst_clause_def
   by (auto intro: min_dnf_finite min_product_set_finite)
 
 lemma subst_dnf_finite:
   "finite \<A> \<Longrightarrow> finite (subst_dnf \<A> m)"
   unfolding subst_dnf_def using subst_clause_finite by blast
 
 lemma subst_dnf_mono:
   "\<A> \<subseteq> \<B> \<Longrightarrow> subst_dnf \<A> m \<subseteq> subst_dnf \<B> m"
   unfolding subst_dnf_def by blast
 
 lemma subst_clause_min_set[simp]:
   "min_set (subst_clause \<Phi> m) = subst_clause \<Phi> m"
   unfolding subst_clause_def by simp
 
 lemma subst_clause_finsert[simp]:
   "subst_clause (finsert \<phi> \<Phi>) m = (min_dnf (subst \<phi> m)) \<otimes>\<^sub>m (subst_clause \<Phi> m)"
 proof -
   have "{min_dnf (subst \<psi> m) | \<psi>. \<psi> \<in> fset (finsert \<phi> \<Phi>)}
     = insert (min_dnf (subst \<phi> m)) {min_dnf (subst \<psi> m) | \<psi>. \<psi> \<in> fset \<Phi>}"
     by auto
 
   then show ?thesis
     by (simp add: subst_clause_def)
 qed
 
 lemma subst_clause_funion[simp]:
   "subst_clause (\<Phi> |\<union>| \<Psi>) m = (subst_clause \<Phi> m) \<otimes>\<^sub>m (subst_clause \<Psi> m)"
 proof (induction \<Psi>)
   case (insert x F)
   then show ?case
     using min_product_set_thms.fun_left_comm by fastforce
 qed simp
 
 
 text \<open>For the proof of correctness, we redefine the @{const product} operator on lists.\<close>
 
 definition list_product :: "'a list set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" (infixl "\<otimes>\<^sub>l" 65)
 where
   "A \<otimes>\<^sub>l B = {a @ b | a b. a \<in> A \<and> b \<in> B}"
 
 lemma list_product_fset_of_list[simp]:
   "fset_of_list ` (A \<otimes>\<^sub>l B) = (fset_of_list ` A) \<otimes> (fset_of_list ` B)"
   unfolding list_product_def product_def image_def by fastforce
 
 lemma list_product_finite:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A \<otimes>\<^sub>l B)"
   unfolding list_product_def by (simp add: finite_image_set2)
 
 lemma list_product_iff:
   "x \<in> A \<otimes>\<^sub>l B \<longleftrightarrow> (\<exists>a b. a \<in> A \<and> b \<in> B \<and> x = a @ b)"
   unfolding list_product_def by blast
 
 lemma list_product_assoc[simp]:
   "A \<otimes>\<^sub>l (B \<otimes>\<^sub>l C) = A \<otimes>\<^sub>l B \<otimes>\<^sub>l C"
   unfolding set_eq_iff list_product_iff by fastforce
 
 
 text \<open>Furthermore, we introduct DNFs where the clauses are represented as lists.\<close>
 
 fun list_dnf :: "'a ltln \<Rightarrow> 'a ltln list set"
 where
   "list_dnf true\<^sub>n = {[]}"
 | "list_dnf false\<^sub>n = {}"
 | "list_dnf (\<phi> and\<^sub>n \<psi>) = (list_dnf \<phi>) \<otimes>\<^sub>l (list_dnf \<psi>)"
 | "list_dnf (\<phi> or\<^sub>n \<psi>) = (list_dnf \<phi>) \<union> (list_dnf \<psi>)"
 | "list_dnf \<phi> = {[\<phi>]}"
 
 definition list_dnf_to_dnf :: "'a list set \<Rightarrow> 'a fset set"
 where
   "list_dnf_to_dnf X = fset_of_list ` X"
 
 lemma list_dnf_to_dnf_list_dnf[simp]:
   "list_dnf_to_dnf (list_dnf \<phi>) = dnf \<phi>"
   by (induction \<phi>) (simp_all add: list_dnf_to_dnf_def image_Un)
 
 lemma list_dnf_finite:
   "finite (list_dnf \<phi>)"
   by (induction \<phi>) (simp_all add: list_product_finite)
 
 
 text \<open>We use this to redefine @{const subst_clause} and @{const subst_dnf} on list DNFs.\<close>
 
 definition subst_clause' :: "'a ltln list \<Rightarrow> ('a ltln \<rightharpoonup> 'a ltln) \<Rightarrow> 'a ltln list set"
 where
   "subst_clause' \<Phi> m = fold (\<lambda>\<phi> acc. acc \<otimes>\<^sub>l list_dnf (subst \<phi> m)) \<Phi> {[]}"
 
 definition subst_dnf' :: "'a ltln list set \<Rightarrow> ('a ltln \<rightharpoonup> 'a ltln) \<Rightarrow> 'a ltln list set"
 where
   "subst_dnf' \<A> m = (\<Union>\<Phi> \<in> \<A>. subst_clause' \<Phi> m)"
 
 lemma subst_clause'_finite:
   "finite (subst_clause' \<Phi> m)"
   by (induction \<Phi> rule: rev_induct) (simp_all add: subst_clause'_def list_dnf_finite list_product_finite)
 
 lemma subst_clause'_nil[simp]:
   "subst_clause' [] m = {[]}"
   by (simp add: subst_clause'_def)
 
 lemma subst_clause'_cons[simp]:
   "subst_clause' (xs @ [x]) m = subst_clause' xs m \<otimes>\<^sub>l list_dnf (subst x m)"
   by (simp add: subst_clause'_def)
 
 lemma subst_clause'_append[simp]:
   "subst_clause' (A @ B) m = subst_clause' A m \<otimes>\<^sub>l subst_clause' B m"
 proof (induction B rule: rev_induct)
   case (snoc x xs)
   then show ?case
     by simp (metis append_assoc subst_clause'_cons)
 qed(simp add: list_product_def)
 
 
 lemma subst_dnf'_iff:
   "x \<in> subst_dnf' A m \<longleftrightarrow> (\<exists>\<Phi> \<in> A. x \<in> subst_clause' \<Phi> m)"
   by (simp add: subst_dnf'_def)
 
 lemma subst_dnf'_product:
   "subst_dnf' (A \<otimes>\<^sub>l B) m = (subst_dnf' A m) \<otimes>\<^sub>l (subst_dnf' B m)" (is "?lhs = ?rhs")
 proof (unfold set_eq_iff, safe)
   fix x
   assume "x \<in> ?lhs"
 
   then obtain \<Phi> where "\<Phi> \<in> A \<otimes>\<^sub>l B" and "x \<in> subst_clause' \<Phi> m"
     unfolding subst_dnf'_iff by blast
 
   then obtain a b where "a \<in> A" and "b \<in> B" and "\<Phi> = a @ b"
     unfolding list_product_def by blast
 
   then have "x \<in> (subst_clause' a m) \<otimes>\<^sub>l (subst_clause' b m)"
     using \<open>x \<in> subst_clause' \<Phi> m\<close> by simp
 
   then obtain a' b' where "a' \<in> subst_clause' a m" and "b' \<in> subst_clause' b m" and "x = a' @ b'"
     unfolding list_product_iff by blast
 
   then have "a' \<in> subst_dnf' A m" and "b' \<in> subst_dnf' B m"
     unfolding subst_dnf'_iff using \<open>a \<in> A\<close> \<open>b \<in> B\<close> by auto
 
   then have "\<exists>a\<in>subst_dnf' A m. \<exists>b\<in>subst_dnf' B m. x = a @ b"
     using \<open>x = a' @ b'\<close> by blast
 
   then show "x \<in> ?rhs"
     unfolding list_product_iff by blast
 next
   fix x
   assume "x \<in> ?rhs"
 
   then obtain a b where "a \<in> subst_dnf' A m" and "b \<in> subst_dnf' B m" and "x = a @ b"
     unfolding list_product_iff by blast
 
   then obtain a' b' where "a' \<in> A" and "b' \<in> B" and a: "a \<in> subst_clause' a' m" and b: "b \<in> subst_clause' b' m"
     unfolding subst_dnf'_iff by blast
 
   then have "x \<in> (subst_clause' a' m) \<otimes>\<^sub>l (subst_clause' b' m)"
     unfolding list_product_iff using \<open>x = a @ b\<close> by blast
 
   moreover
 
   have "a' @ b' \<in> A \<otimes>\<^sub>l B"
     unfolding list_product_iff using \<open>a' \<in> A\<close> \<open>b' \<in> B\<close> by blast
 
   ultimately show "x \<in> ?lhs"
     unfolding subst_dnf'_iff by force
 qed
 
 lemma subst_dnf'_list_dnf:
   "subst_dnf' (list_dnf \<phi>) m = list_dnf (subst \<phi> m)"
 proof (induction \<phi>)
   case (And_ltln \<phi>1 \<phi>2)
   then show ?case
     by (simp add: subst_dnf'_product)
 qed (simp_all add: subst_dnf'_def subst_clause'_def list_product_def)
 
 
 lemma min_set_Union:
   "finite X \<Longrightarrow> min_set (\<Union> (min_set ` X)) = min_set (\<Union> X)" for X :: "'a fset set set"
   by (induction X rule: finite_induct) (force, metis Sup_insert image_insert min_set_min_union min_union_def)
 
 lemma min_set_Union_image:
   "finite X \<Longrightarrow> min_set (\<Union>x \<in> X. min_set (f x)) = min_set (\<Union>x \<in> X. f x)" for f :: "'b \<Rightarrow> 'a fset set"
 proof -
   assume "finite X"
 
   then have *: "finite (f ` X)" by auto
 
   with min_set_Union show ?thesis
     unfolding image_image by fastforce
 qed
 
 lemma subst_clause_fset_of_list:
   "subst_clause (fset_of_list \<Phi>) m = min_set (list_dnf_to_dnf (subst_clause' \<Phi> m))"
   unfolding list_dnf_to_dnf_def subst_clause'_def
 proof (induction \<Phi> rule: rev_induct)
   case (snoc x xs)
   then show ?case
     by simp (metis (no_types, lifting) dnf_min_set list_dnf_to_dnf_def list_dnf_to_dnf_list_dnf min_product_comm min_product_def min_set_min_product(1))
 qed simp
 
 lemma min_set_list_dnf_to_dnf_subst_dnf':
   "finite X \<Longrightarrow> min_set (list_dnf_to_dnf (subst_dnf' X m)) = min_set (subst_dnf (list_dnf_to_dnf X) m)"
   by (simp add: subst_dnf'_def subst_dnf_def subst_clause_fset_of_list list_dnf_to_dnf_def min_set_Union_image image_Union)
 
 lemma subst_dnf_dnf:
   "min_set (subst_dnf (dnf \<phi>) m) = min_dnf (subst \<phi> m)"
   unfolding dnf_min_set
   unfolding list_dnf_to_dnf_list_dnf[symmetric]
   unfolding subst_dnf'_list_dnf[symmetric]
   unfolding min_set_list_dnf_to_dnf_subst_dnf'[OF list_dnf_finite]
   by simp
 
 
 text \<open>This is almost the lemma we need. However, we need to show that the same holds for @{term "min_dnf \<phi>"}, too.\<close>
 
 lemma fold_product:
   "Finite_Set.fold (\<lambda>x. (\<otimes>) {{|x|}}) {{||}} (fset x) = {x}"
   by (induction x) (simp_all, simp add: product_singleton_singleton)
 
 lemma fold_union:
   "Finite_Set.fold (\<lambda>x. (\<union>) {x}) {} (fset x) = fset x"
   by (induction x) (simp_all add: comp_fun_idem_on.fold_insert_idem[OF comp_fun_idem_insert[unfolded comp_fun_idem_def']])
 
 lemma fold_union_fold_product:
   assumes "finite X" and "\<And>\<Psi> \<psi>. \<Psi> \<in> X \<Longrightarrow> \<psi> \<in> fset \<Psi> \<Longrightarrow> dnf \<psi> = {{|\<psi>|}}"
   shows "Finite_Set.fold (\<lambda>x. (\<union>) (Finite_Set.fold (\<lambda>\<phi>. (\<otimes>) (dnf \<phi>)) {{||}} (fset x))) {} X = X" (is "?lhs = X")
 proof -
   from assms have "?lhs = Finite_Set.fold (\<lambda>x. (\<union>) (Finite_Set.fold (\<lambda>\<phi>. (\<otimes>) {{|\<phi>|}}) {{||}} (fset x))) {} X"
   proof (induction X rule: finite_induct)
     case (insert \<Phi> X)
 
     from insert.prems have 1: "\<And>\<Psi> \<psi>. \<lbrakk>\<Psi> \<in> X; \<psi> \<in> fset \<Psi>\<rbrakk> \<Longrightarrow> dnf \<psi> = {{|\<psi>|}}"
       by force
 
     from insert.prems have "Finite_Set.fold (\<lambda>\<phi>. (\<otimes>) (dnf \<phi>)) {{||}} (fset \<Phi>) = Finite_Set.fold (\<lambda>\<phi>. (\<otimes>) {{|\<phi>|}}) {{||}} (fset \<Phi>)"
       by (induction \<Phi>) force+
 
     with insert 1 show ?case
       by simp
   qed simp
 
   with \<open>finite X\<close> show ?thesis
     unfolding fold_product by (metis fset_to_fset fold_union)
 qed
 
 lemma dnf_ltln_of_dnf_min_dnf:
   "dnf (ltln_of_dnf (min_dnf \<phi>)) = min_dnf \<phi>"
 proof -
   have 1: "finite (And\<^sub>n ` fset ` min_dnf \<phi>)"
     using min_dnf_finite by blast
 
   have 2: "inj_on And\<^sub>n (fset ` min_dnf \<phi>)"
     by (metis (mono_tags, lifting) And\<^sub>n_inj f_inv_into_f fset inj_onI inj_on_contraD)
 
   have 3: "inj_on fset (min_dnf \<phi>)"
     by (meson fset_inject inj_onI)
 
   show ?thesis
     unfolding ltln_of_dnf_def
     unfolding Or\<^sub>n_dnf[OF 1]
     unfolding fold_image[OF 2]
     unfolding fold_image[OF 3]
     unfolding comp_def
     unfolding And\<^sub>n_dnf[OF finite_fset]
     by (metis fold_union_fold_product min_dnf_finite min_dnf_atoms_dnf)
 qed
 
 lemma min_dnf_subst:
   "min_set (subst_dnf (min_dnf \<phi>) m) = min_dnf (subst \<phi> m)" (is "?lhs = ?rhs")
 proof -
   let ?\<phi>' = "ltln_of_dnf (min_dnf \<phi>)"
 
   have "?lhs = min_set (subst_dnf (dnf ?\<phi>') m)"
     unfolding dnf_ltln_of_dnf_min_dnf ..
 
   also have "\<dots> = min_dnf (subst ?\<phi>' m)"
     unfolding subst_dnf_dnf ..
 
   also have "\<dots> = min_dnf (subst \<phi> m)"
     using ltl_prop_equiv_min_dnf ltln_of_dnf_prop_equiv subst_respects_ltl_prop_entailment(2) by blast
 
   finally show ?thesis .
 qed
 
 end
diff --git a/thys/Monomorphic_Monad/Monomorphic_Monad.thy b/thys/Monomorphic_Monad/Monomorphic_Monad.thy
--- a/thys/Monomorphic_Monad/Monomorphic_Monad.thy
+++ b/thys/Monomorphic_Monad/Monomorphic_Monad.thy
@@ -1,4345 +1,4345 @@
 (*  Title:      Monomorphic_Monad.thy
     Author:     Andreas Lochbihler, ETH Zurich *)
 
 theory Monomorphic_Monad imports
   "HOL-Probability.Probability"
   "HOL-Library.Multiset"
   "HOL-Library.Countable_Set_Type"
 begin
 
 section \<open>Preliminaries\<close>
 
 lemma (in comp_fun_idem) fold_set_union:
   "\<lbrakk> finite A; finite B \<rbrakk> \<Longrightarrow> Finite_Set.fold f x (A \<union> B) = Finite_Set.fold f (Finite_Set.fold f x A) B"
 by(induction A arbitrary: x rule: finite_induct)(simp_all add: fold_insert_idem2 del: fold_insert_idem)
 
 lemma (in comp_fun_idem) ffold_set_union: "ffold f x (A |\<union>| B) = ffold f (ffold f x A) B"
 including fset.lifting by(transfer fixing: f)(rule fold_set_union)
 
 lemma relcompp_top_top [simp]: "top OO top = top"
 by(auto simp add: fun_eq_iff)
 
 attribute_setup locale_witness = \<open>Scan.succeed Locale.witness_add\<close>
 
 named_theorems monad_unfold "Defining equations for overloaded monad operations"
 
 context includes lifting_syntax begin
 
 inductive rel_itself :: "'a itself \<Rightarrow> 'b itself \<Rightarrow> bool"
 where "rel_itself TYPE(_) TYPE(_)"
 
 lemma type_parametric [transfer_rule]: "rel_itself TYPE('a) TYPE('b)"
 by(simp add: rel_itself.simps)
 lemma plus_multiset_parametric [transfer_rule]:
   "(rel_mset A ===> rel_mset A ===> rel_mset A) (+) (+)"
   apply(rule rel_funI)+
   subgoal premises prems using prems by induction(auto intro: rel_mset_Plus)
   done
 
 lemma Mempty_parametric [transfer_rule]: "rel_mset A {#} {#}"
   by(fact rel_mset_Zero)
 
 lemma fold_mset_parametric:
   assumes 12: "(A ===> B ===> B) f1 f2"
   and "comp_fun_commute f1" "comp_fun_commute f2"
   shows "(B ===> rel_mset A ===> B) (fold_mset f1) (fold_mset f2)"
 proof(rule rel_funI)+
   interpret f1: comp_fun_commute f1 by fact
   interpret f2: comp_fun_commute f2 by fact
 
   show "B (fold_mset f1 z1 X) (fold_mset f2 z2 Y)" 
     if "rel_mset A X Y" "B z1 z2" for z1 z2 X Y
     using that(1) by(induction R\<equiv>A X Y)(simp_all add: that(2) 12[THEN rel_funD, THEN rel_funD])
 qed
 
 lemma rel_fset_induct [consumes 1, case_names empty step, induct pred: rel_fset]:
   assumes XY: "rel_fset A X Y"
     and empty: "P {||} {||}"
     and step: "\<And>X Y x y. \<lbrakk> rel_fset A X Y; P X Y; A x y; x |\<notin>| X \<or> y |\<notin>| Y \<rbrakk> \<Longrightarrow> P (finsert x X) (finsert y Y)"
   shows "P X Y"
 proof -
   from XY obtain Z where X: "X = fst |`| Z" and Y: "Y = snd |`| Z" and Z: "fBall Z (\<lambda>(x, y). A x y)"
-    unfolding fset.in_rel by(auto simp add: fBall.rep_eq)
+    unfolding fset.in_rel by auto
   from Z show ?thesis unfolding X Y
   proof(induction Z)
     case (insert xy Z)
     obtain x y where [simp]: "xy = (x, y)" by(cases xy)
     show ?case using insert
       apply(cases "x |\<in>| fst |`| Z \<and> y |\<in>| snd |`| Z")
        apply(simp add: finsert_absorb)
-      apply(auto intro!: step simp add: fset.in_rel fBall.rep_eq; blast)
+      apply(auto intro!: step simp add: fset.in_rel; blast)
       done
   qed(simp add: assms)
 qed
 
 lemma ffold_parametric:
   assumes 12: "(A ===> B ===> B) f1 f2"
   and "comp_fun_idem f1" "comp_fun_idem f2"
   shows "(B ===> rel_fset A ===> B) (ffold f1) (ffold f2)"
 proof(rule rel_funI)+
   interpret f1: comp_fun_idem f1 by fact
   interpret f2: comp_fun_idem f2 by fact
 
   show "B (ffold f1 z1 X) (ffold f2 z2 Y)" 
     if "rel_fset A X Y" "B z1 z2" for z1 z2 X Y
     using that(1) by(induction)(simp_all add: that(2) 12[THEN rel_funD, THEN rel_funD])
 qed
 
 end
 
 lemma rel_set_Grp: "rel_set (BNF_Def.Grp A f) = BNF_Def.Grp {X. X \<subseteq> A} (image f)"
   by(auto simp add: fun_eq_iff Grp_def rel_set_def)
 
 context includes cset.lifting begin
 
 lemma cUNION_assoc: "cUNION (cUNION A f) g = cUNION A (\<lambda>x. cUNION (f x) g)"
   by transfer auto
 
 lemma cUnion_cempty [simp]: "cUnion cempty = cempty"
   by transfer simp
 
 lemma cUNION_cempty [simp]: "cUNION cempty f = cempty"
   by simp
 
 lemma cUnion_cinsert: "cUnion (cinsert x A) = cUn x (cUnion A)"
   by transfer simp
 
 lemma cUNION_cinsert: "cUNION (cinsert x A) f = cUn (f x) (cUNION A f)"
   by (simp add: cUnion_cinsert)
 
 lemma cUnion_csingle [simp]: "cUnion (csingle x) = x"
   by (simp add: cUnion_cinsert)
 
 lemma cUNION_csingle [simp]: "cUNION (csingle x) f = f x"
   by simp
 
 lemma cUNION_csingle2 [simp]: "cUNION A csingle = A"
   by (fact cUN_csingleton)
 
 lemma cUNION_cUn: "cUNION (cUn A B) f = cUn (cUNION A f) (cUNION B f)"
   by simp
 
 lemma cUNION_parametric [transfer_rule]: includes lifting_syntax shows
   "(rel_cset A ===> (A ===> rel_cset B) ===> rel_cset B) cUNION cUNION"
   unfolding rel_fun_def by transfer(blast intro: rel_set_UNION)
 
 end
 
 locale three =
   fixes tytok :: "'a itself"
   assumes ex_three: "\<exists>x y z :: 'a. x \<noteq> y \<and> x \<noteq> z \<and> y \<noteq> z"
 begin
 
 definition threes :: "'a \<times> 'a \<times> 'a" where
   "threes = (SOME (x, y, z). x \<noteq> y \<and> x \<noteq> z \<and> y \<noteq> z)"
 definition three\<^sub>1 :: 'a ("\<^bold>1") where "\<^bold>1 = fst threes"
 definition three\<^sub>2 :: 'a ("\<^bold>2") where "\<^bold>2 = fst (snd threes)"
 definition three\<^sub>3 :: 'a ("\<^bold>3") where "\<^bold>3 = snd (snd (threes))"
 
 lemma three_neq_aux: "\<^bold>1 \<noteq> \<^bold>2" "\<^bold>1 \<noteq> \<^bold>3" "\<^bold>2 \<noteq> \<^bold>3"
 proof -
   have "\<^bold>1 \<noteq> \<^bold>2 \<and> \<^bold>1 \<noteq> \<^bold>3 \<and> \<^bold>2 \<noteq> \<^bold>3"
     unfolding three\<^sub>1_def three\<^sub>2_def three\<^sub>3_def threes_def split_def
     by(rule someI_ex)(use ex_three in auto)
   then show "\<^bold>1 \<noteq> \<^bold>2" "\<^bold>1 \<noteq> \<^bold>3" "\<^bold>2 \<noteq> \<^bold>3" by simp_all
 qed
 
 lemmas three_neq [simp] = three_neq_aux three_neq_aux[symmetric]
 
 inductive rel_12_23 :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
   "rel_12_23 \<^bold>1 \<^bold>2"
 | "rel_12_23 \<^bold>2 \<^bold>3"
 
 lemma bi_unique_rel_12_23 [simp, transfer_rule]: "bi_unique rel_12_23"
   by(auto simp add: bi_unique_def rel_12_23.simps)
 
 inductive rel_12_21 :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
   "rel_12_21 \<^bold>1 \<^bold>2"
 | "rel_12_21 \<^bold>2 \<^bold>1"
 
 lemma bi_unique_rel_12_21 [simp, transfer_rule]: "bi_unique rel_12_21"
   by(auto simp add: bi_unique_def rel_12_21.simps)
 
 end
 
 lemma bernoulli_pmf_0: "bernoulli_pmf 0 = return_pmf False"
   by(rule pmf_eqI)(simp split: split_indicator)
 
 lemma bernoulli_pmf_1: "bernoulli_pmf 1 = return_pmf True"
   by(rule pmf_eqI)(simp split: split_indicator)
 
 lemma bernoulli_Not: "map_pmf Not (bernoulli_pmf r) = bernoulli_pmf (1 - r)"
   apply(rule pmf_eqI)
   apply(rewrite in "pmf _ \<hole> = _" not_not[symmetric])
   apply(subst pmf_map_inj')
   apply(simp_all add: inj_on_def bernoulli_pmf.rep_eq min_def max_def)
   done
 
 lemma pmf_eqI_avoid: "p = q" if "\<And>i. i \<noteq> x \<Longrightarrow> pmf p i = pmf q i"
 proof(rule pmf_eqI)
   show "pmf p i = pmf q i" for i
   proof(cases "i = x")
     case [simp]: True
     have "pmf p i = measure_pmf.prob p {i}" by(simp add: measure_pmf_single)
     also have "\<dots> = 1 - measure_pmf.prob p (UNIV - {i})"
       by(subst measure_pmf.prob_compl[unfolded space_measure_pmf]) simp_all
     also have "measure_pmf.prob p (UNIV - {i}) = measure_pmf.prob q (UNIV - {i})"
       unfolding integral_pmf[symmetric] by(rule Bochner_Integration.integral_cong)(auto intro: that)
     also have "1 - \<dots> = measure_pmf.prob q {i}"
       by(subst measure_pmf.prob_compl[unfolded space_measure_pmf]) simp_all
     also have "\<dots> = pmf q i" by(simp add: measure_pmf_single)
     finally show ?thesis .
   next
     case False
     then show ?thesis by(rule that)
   qed
 qed
 
 section \<open>Locales for monomorphic monads\<close>
 
 subsection \<open>Plain monad\<close>
 
 type_synonym ('a, 'm) bind = "'m \<Rightarrow> ('a \<Rightarrow> 'm) \<Rightarrow> 'm"
 type_synonym ('a, 'm) return = "'a \<Rightarrow> 'm"
 
 locale monad_base =
   fixes return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
 begin
 
 primrec sequence :: "'m list \<Rightarrow> ('a list \<Rightarrow> 'm) \<Rightarrow> 'm"
 where
   "sequence [] f = f []"
 | "sequence (x # xs) f = bind x (\<lambda>a. sequence xs (f \<circ> (#) a))"
 
 definition lift :: "('a \<Rightarrow> 'a) \<Rightarrow> 'm \<Rightarrow> 'm"
 where "lift f x = bind x (\<lambda>x. return (f x))"
 
 end
 
 declare
   monad_base.sequence.simps [code]
   monad_base.lift_def [code]
 
 context includes lifting_syntax begin
 
 lemma sequence_parametric [transfer_rule]:
   "((M ===> (A ===> M) ===> M) ===> list_all2 M ===> (list_all2 A ===> M) ===> M) monad_base.sequence monad_base.sequence"
 unfolding monad_base.sequence_def[abs_def] by transfer_prover
 
 lemma lift_parametric [transfer_rule]:
   "((A ===> M) ===> (M ===> (A ===> M) ===> M) ===> (A ===> A) ===> M ===> M) monad_base.lift monad_base.lift"
 unfolding monad_base.lift_def by transfer_prover
 
 end
 
 locale monad = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   assumes bind_assoc: "\<And>(x :: 'm) f g. bind (bind x f) g = bind x (\<lambda>y. bind (f y) g)" 
   and return_bind: "\<And>x f. bind (return x) f = f x"
   and bind_return: "\<And>x. bind x return = x"
 begin
 
 lemma bind_lift [simp]: "bind (lift f x) g = bind x (g \<circ> f)"
 by(simp add: lift_def bind_assoc return_bind o_def)
 
 lemma lift_bind [simp]: "lift f (bind m g) = bind m (\<lambda>x. lift f (g x))"
 by(simp add: lift_def bind_assoc)
 
 end
 
 subsection \<open>State\<close>
 
 type_synonym ('s, 'm) get = "('s \<Rightarrow> 'm) \<Rightarrow> 'm"
 type_synonym ('s, 'm) put = "'s \<Rightarrow> 'm \<Rightarrow> 'm"
 
 locale monad_state_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
 begin
 
 definition update :: "('s \<Rightarrow> 's) \<Rightarrow> 'm \<Rightarrow> 'm"
 where "update f m = get (\<lambda>s. put (f s) m)"
 
 end
 
 declare monad_state_base.update_def [code]
 
 lemma update_parametric [transfer_rule]: includes lifting_syntax shows  
   "(((S ===> M) ===> M) ===> (S ===> M ===> M) ===> (S ===> S) ===> M ===> M)
    monad_state_base.update monad_state_base.update"
 unfolding monad_state_base.update_def by transfer_prover
 
 locale monad_state = monad_state_base return bind get put + monad return bind 
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   +
   assumes put_get: "\<And>f. put s (get f) = put s (f s)"
   and get_get: "\<And>f. get (\<lambda>s. get (f s)) = get (\<lambda>s. f s s)"
   and put_put: "put s (put s' m) = put s' m"
   and get_put: "get (\<lambda>s. put s m) = m"
   and get_const: "\<And>m. get (\<lambda>_. m) = m"
   and bind_get: "\<And>f g. bind (get f) g = get (\<lambda>s. bind (f s) g)"
   and bind_put: "\<And>f. bind (put s m) f = put s (bind m f)"
 begin
 
 lemma put_update: "put s (update f m) = put (f s) m"
 by(simp add: update_def put_get put_put)
 
 lemma update_put: "update f (put s m) = put s m"
 by(simp add: update_def put_put get_const)
 
 lemma bind_update: "bind (update f m) g = update f (bind m g)"
 by(simp add: update_def bind_get bind_put)
 
 lemma update_get: "update f (get g) = get (update f \<circ> g \<circ> f)"
 by(simp add: update_def put_get get_get o_def) 
  
 lemma update_const: "update (\<lambda>_. s) m = put s m"
 by(simp add: update_def get_const)
 
 lemma update_update: "update f (update g m) = update (g \<circ> f) m"
 by(simp add: update_def put_get put_put)
 
 lemma update_id: "update id m = m"
 by(simp add: update_def get_put)
 
 end
 
 subsection \<open>Failure\<close>
 
 type_synonym 'm fail = "'m"
 
 locale monad_fail_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes fail :: "'m fail"
 begin
 
 definition assert :: "('a \<Rightarrow> bool) \<Rightarrow> 'm \<Rightarrow> 'm"
 where "assert P m = bind m (\<lambda>x. if P x then return x else fail)"
 
 end
 
 declare monad_fail_base.assert_def [code]
 
 lemma assert_parametric [transfer_rule]: includes lifting_syntax shows
   "((A ===> M) ===> (M ===> (A ===> M) ===> M) ===> M ===> (A ===> (=)) ===> M ===> M)
    monad_fail_base.assert monad_fail_base.assert"
 unfolding monad_fail_base.assert_def by transfer_prover
 
 locale monad_fail = monad_fail_base return bind fail + monad return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and fail :: "'m fail"
   +
   assumes fail_bind: "\<And>f. bind fail f = fail"
 begin
 
 lemma assert_fail: "assert P fail = fail"
 by(simp add: assert_def fail_bind)
 
 end
 
 subsection \<open>Exception\<close>
 
 type_synonym 'm catch = "'m \<Rightarrow> 'm \<Rightarrow> 'm"
 
 locale monad_catch_base = monad_fail_base return bind fail
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and fail :: "'m fail"
   +
   fixes catch :: "'m catch"
 
 locale monad_catch = monad_catch_base return bind fail catch + monad_fail return bind fail
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and fail :: "'m fail"
   and catch :: "'m catch"
   +
   assumes catch_return: "catch (return x) m = return x"
   and catch_fail: "catch fail m = m"
   and catch_fail2: "catch m fail = m"
   and catch_assoc: "catch (catch m m') m'' = catch m (catch m' m'')"
 
 locale monad_catch_state = monad_catch return bind fail catch + monad_state return bind get put
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and fail :: "'m fail"
   and catch :: "'m catch"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   +
   assumes catch_get: "catch (get f) m = get (\<lambda>s. catch (f s) m)"
   and catch_put: "catch (put s m) m' = put s (catch m m')"
 begin
 
 lemma catch_update: "catch (update f m) m' = update f (catch m m')"
 by(simp add: update_def catch_get catch_put)
 
 end
 
 subsection \<open>Reader\<close>
 
 text \<open>As ask takes a continuation, we have to restate the monad laws for ask\<close>
 
 type_synonym ('r, 'm) ask = "('r \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 locale monad_reader_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes ask :: "('r, 'm) ask"
 
 locale monad_reader = monad_reader_base return bind ask + monad return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and ask :: "('r, 'm) ask"
   +
   assumes ask_ask: "\<And>f. ask (\<lambda>r. ask (f r)) = ask (\<lambda>r. f r r)"
   and ask_const: "ask (\<lambda>_. m) = m"
   and bind_ask: "\<And>f g. bind (ask f) g = ask (\<lambda>r. bind (f r) g)"
   and bind_ask2: "\<And>f. bind m (\<lambda>x. ask (f x)) = ask (\<lambda>r. bind m (\<lambda>x. f x r))"
 begin
 
 lemma ask_bind: "ask (\<lambda>r. bind (f r) (g r)) = bind (ask f) (\<lambda>x. ask (\<lambda>r. g r x))"
 by(simp add: bind_ask bind_ask2 ask_ask)
 
 end
 
 locale monad_reader_state =
   monad_reader return bind ask +
   monad_state return bind get put
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and ask :: "('r, 'm) ask"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   +
   assumes ask_get: "\<And>f. ask (\<lambda>r. get (f r)) = get (\<lambda>s. ask (\<lambda>r. f r s))"
   and put_ask: "\<And>f. put s (ask f) = ask (\<lambda>r. put s (f r))"
 
 subsection \<open>Probability\<close>
 
 type_synonym ('p, 'm) sample = "'p pmf \<Rightarrow> ('p \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 locale monad_prob_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes sample :: "('p, 'm) sample"
 
 locale monad_prob = monad return bind + monad_prob_base return bind sample
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and sample :: "('p, 'm) sample"
   +
   assumes sample_const: "\<And>p m. sample p (\<lambda>_. m) = m"
   and sample_return_pmf: "\<And>x f. sample (return_pmf x) f = f x"
   and sample_bind_pmf: "\<And>p f g. sample (bind_pmf p f) g = sample p (\<lambda>x. sample (f x) g)"
   and sample_commute: "\<And>p q f. sample p (\<lambda>x. sample q (f x)) = sample q (\<lambda>y. sample p (\<lambda>x. f x y))"
   \<comment> \<open>We'd like to state that we can combine independent samples rather than just commute them, but that's not possible with a monomorphic sampling operation\<close>
   and bind_sample1: "\<And>p f g. bind (sample p f) g = sample p (\<lambda>x. bind (f x) g)"
   and bind_sample2: "\<And>m f p. bind m (\<lambda>y. sample p (f y)) = sample p (\<lambda>x. bind m (\<lambda>y. f y x))"
   and sample_parametric: "\<And>R. bi_unique R \<Longrightarrow> rel_fun (rel_pmf R) (rel_fun (rel_fun R (=)) (=)) sample sample"
 begin
 
 lemma sample_cong: "(\<And>x. x \<in> set_pmf p \<Longrightarrow> f x = g x) \<Longrightarrow> sample p f = sample q g" if "p = q"
   by(rule sample_parametric[where R="eq_onp (\<lambda>x. x \<in> set_pmf p)", THEN rel_funD, THEN rel_funD])
     (simp_all add: bi_unique_def eq_onp_def rel_fun_def pmf.rel_refl_strong that)
 
 end
 
 text \<open>We can implement binary probabilistic choice using @{term sample} provided that the sample space
   contains at least three elements.\<close>
 
 locale monad_prob3 = monad_prob return bind sample + three "TYPE('p)"
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and sample :: "('p, 'm) sample"
 begin
 
 definition pchoose :: "real \<Rightarrow> 'm \<Rightarrow> 'm \<Rightarrow> 'm" where
   "pchoose r m m' = sample (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf r)) (\<lambda>x. if x = \<^bold>1 then m else m')"
 
 abbreviation pchoose_syntax :: "'m \<Rightarrow> real \<Rightarrow> 'm \<Rightarrow> 'm" ("_ \<lhd> _ \<rhd> _" [100, 0, 100] 99) where
   "m \<lhd> r \<rhd> m' \<equiv> pchoose r m m'"
 
 lemma pchoose_0: "m \<lhd> 0 \<rhd> m' = m'"
   by(simp add: pchoose_def bernoulli_pmf_0 sample_return_pmf)
 
 lemma pchoose_1: "m \<lhd> 1 \<rhd> m' = m"
   by(simp add: pchoose_def bernoulli_pmf_1 sample_return_pmf)
 
 lemma pchoose_idemp: "m \<lhd> r \<rhd> m = m"
   by(simp add: pchoose_def sample_const)
 
 lemma pchoose_bind1: "bind (m \<lhd> r \<rhd> m') f = bind m f \<lhd> r \<rhd> bind m' f"
   by(simp add: pchoose_def bind_sample1 if_distrib[where f="\<lambda>m. bind m _"])
 
 lemma pchoose_bind2: "bind m (\<lambda>x. f x \<lhd> p \<rhd> g x) = bind m f \<lhd> p \<rhd> bind m g"
   by(auto simp add: pchoose_def bind_sample2 intro!: arg_cong2[where f=sample])
 
 lemma pchoose_commute: "m \<lhd> 1 - r \<rhd> m' = m' \<lhd> r \<rhd> m"
   apply(simp add: pchoose_def bernoulli_Not[symmetric] pmf.map_comp o_def)
   apply(rule sample_parametric[where R=rel_12_21, THEN rel_funD, THEN rel_funD])
   subgoal by(simp)
   subgoal by(rule pmf.map_transfer[where Rb="(=)", THEN rel_funD, THEN rel_funD])
             (simp_all add: rel_fun_def rel_12_21.simps pmf.rel_eq)
   subgoal by(simp add: rel_fun_def rel_12_21.simps)
   done
 
 lemma pchoose_assoc: "m \<lhd> p \<rhd> (m' \<lhd> q \<rhd> m'') = (m \<lhd> r \<rhd> m') \<lhd> s \<rhd> m''" (is "?lhs = ?rhs")
   if "min 1 (max 0 p) = min 1 (max 0 r) * min 1 (max 0 s)"
   and "1 - min 1 (max 0 s) = (1 - min 1 (max 0 p)) * (1 - min 1 (max 0 q))"
 proof -
   let ?f = "(\<lambda>x. if x = \<^bold>1 then m else if x = \<^bold>2 then m' else m'')"
   let ?p = "bind_pmf (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf p))
      (\<lambda>x. if x = \<^bold>1 then return_pmf \<^bold>1 else map_pmf (\<lambda>b. if b then \<^bold>2 else \<^bold>3) (bernoulli_pmf q))"
   let ?q = "bind_pmf (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf s))
      (\<lambda>x. if x = \<^bold>1 then map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf r) else return_pmf \<^bold>3)"
 
   have [simp]: "{x. \<not> x} = {False}" "{x. x} = {True}" by auto
 
   have "?lhs = sample ?p ?f"
     by(auto simp add: pchoose_def sample_bind_pmf if_distrib[where f="\<lambda>x. sample x _"] sample_return_pmf rel_fun_def rel_12_23.simps pmf.rel_eq cong: if_cong intro!: sample_cong[OF refl] sample_parametric[where R="rel_12_23", THEN rel_funD, THEN rel_funD] pmf.map_transfer[where Rb="(=)", THEN rel_funD, THEN rel_funD])
   also have "?p = ?q"
   proof(rule pmf_eqI_avoid)
     fix i :: "'p"
     assume "i \<noteq> \<^bold>2"
     then consider (one) "i = \<^bold>1" | (three) "i = \<^bold>3" | (other) "i \<noteq> \<^bold>1" "i \<noteq> \<^bold>2" "i \<noteq> \<^bold>3" by metis
     then show "pmf ?p i = pmf ?q i"
     proof cases
       case [simp]: one
       have "pmf ?p i = measure_pmf.expectation (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf p)) (indicator {\<^bold>1})"
         unfolding pmf_bind
         by(rule arg_cong2[where f=measure_pmf.expectation, OF refl])(auto simp add: fun_eq_iff pmf_eq_0_set_pmf)
       also have "\<dots> = min 1 (max 0 p)" 
         by(simp add: vimage_def)(simp add: measure_pmf_single bernoulli_pmf.rep_eq)
       also have "\<dots> = min 1 (max 0 s) * min 1 (max 0 r)" using that(1) by simp
       also have "\<dots> = measure_pmf.expectation (bernoulli_pmf s)
             (\<lambda>x. indicator {True} x * pmf (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf r)) \<^bold>1)"
         by(simp add: pmf_map vimage_def measure_pmf_single)(simp add:  bernoulli_pmf.rep_eq)
       also have "\<dots> = pmf ?q i"
         unfolding pmf_bind integral_map_pmf
         by(rule arg_cong2[where f=measure_pmf.expectation, OF refl])(auto simp add: fun_eq_iff pmf_eq_0_set_pmf)
       finally show ?thesis .
     next
       case [simp]: three
       have "pmf ?p i = measure_pmf.expectation (bernoulli_pmf p)
             (\<lambda>x. indicator {False} x * pmf (map_pmf (\<lambda>b. if b then \<^bold>2 else \<^bold>3) (bernoulli_pmf q)) \<^bold>3)"
         unfolding pmf_bind integral_map_pmf
         by(rule arg_cong2[where f=measure_pmf.expectation, OF refl])(auto simp add: fun_eq_iff pmf_eq_0_set_pmf)
       also have "\<dots> = (1 - min 1 (max 0 p)) * (1 - min 1 (max 0 q))" 
         by(simp add: pmf_map vimage_def measure_pmf_single)(simp add:  bernoulli_pmf.rep_eq)
       also have "\<dots> = 1 - min 1 (max 0 s)" using that(2) by simp
       also have "\<dots> = measure_pmf.expectation (map_pmf (\<lambda>b. if b then \<^bold>1 else \<^bold>2) (bernoulli_pmf s)) (indicator {\<^bold>2})"
         by(simp add: vimage_def)(simp add: measure_pmf_single bernoulli_pmf.rep_eq)
       also have "\<dots> = pmf ?q i"
         unfolding pmf_bind
         by(rule Bochner_Integration.integral_cong_AE)(auto simp add: fun_eq_iff pmf_eq_0_set_pmf AE_measure_pmf_iff)
       finally show ?thesis .
     next
       case other
       then have "pmf ?p i = 0" "pmf ?q i = 0" by(auto simp add: pmf_eq_0_set_pmf)
       then show ?thesis by simp
     qed
   qed
   also have "sample ?q ?f = ?rhs"
     by(auto simp add: pchoose_def sample_bind_pmf if_distrib[where f="\<lambda>x. sample x _"] sample_return_pmf cong: if_cong intro!: sample_cong[OF refl])
   finally show ?thesis .
 qed
 
 lemma pchoose_assoc': "m \<lhd> p \<rhd> (m' \<lhd> q \<rhd> m'') = (m \<lhd> r \<rhd> m') \<lhd> s \<rhd> m''"
   if "p = r * s" and "1 - s = (1 - p) * (1 - q)"
   and "0 \<le> p" "p \<le> 1" "0 \<le> q" "q \<le> 1" "0 \<le> r" "r \<le> 1" "0 \<le> s" "s \<le> 1"
   by(rule pchoose_assoc; use that in \<open>simp add: min_def max_def\<close>)
 
 end    
 
 locale monad_state_prob = monad_state return bind get put + monad_prob return bind sample
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   and sample :: "('p, 'm) sample"
   +
   assumes sample_get: "sample p (\<lambda>x. get (f x)) = get (\<lambda>s. sample p (\<lambda>x. f x s))"
 begin
 
 lemma sample_put: "sample p (\<lambda>x. put s (m x)) = put s (sample p m)"
 proof -
   fix UU
   have "sample p (\<lambda>x. put s (m x)) = sample p (\<lambda>x. bind (put s (return UU)) (\<lambda>_. m x))"
     by(simp add: bind_put return_bind)
   also have "\<dots> = bind (put s (return UU)) (\<lambda>_. sample p m)"
     by(simp add: bind_sample2)
   also have "\<dots> = put s (sample p m)"
     by(simp add: bind_put return_bind)
   finally show ?thesis .
 qed
 
 lemma sample_update: "sample p (\<lambda>x. update f (m x)) = update f (sample p m)"
 by(simp add: update_def sample_get sample_put)
 
 end
 
 subsection \<open>Nondeterministic choice\<close>
 
 subsubsection \<open>Binary choice\<close>
 
 type_synonym 'm alt = "'m \<Rightarrow> 'm \<Rightarrow> 'm"
 
 locale monad_alt_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes alt :: "'m alt"
 
 locale monad_alt = monad return bind + monad_alt_base return bind alt
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and alt :: "'m alt"
   + \<comment> \<open>Laws taken from Gibbons, Hinze: Just do it\<close>
   assumes alt_assoc: "alt (alt m1 m2) m3 = alt m1 (alt m2 m3)"
   and bind_alt1: "bind (alt m m') f = alt (bind m f) (bind m' f)"
 
 locale monad_fail_alt = monad_fail return bind fail + monad_alt return bind alt
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and fail :: "'m fail"
   and alt :: "'m alt"
   +
   assumes alt_fail1: "alt fail m = m"
   and alt_fail2: "alt m fail = m"
 begin
 
 lemma assert_alt: "assert P (alt m m') = alt (assert P m) (assert P m')"
 by(simp add: assert_def bind_alt1)
 
 end
 
 locale monad_state_alt = monad_state return bind get put + monad_alt return bind alt
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   and alt :: "'m alt"
   +
   assumes alt_get: "alt (get f) (get g) = get (\<lambda>x. alt (f x) (g x))"
   and alt_put: "alt (put s m) (put s m') = put s (alt m m')"
   \<comment> \<open>Unlike for @{term sample}, we must require both @{text alt_get} and @{text alt_put} because
   we do not require that @{term bind} right-distributes over @{term alt}.\<close>
 begin
 
 lemma alt_update: "alt (update f m) (update f m') = update f (alt m m')"
 by(simp add: update_def alt_get alt_put)
 
 end
 
 subsubsection \<open>Countable choice\<close>
 
 type_synonym ('c, 'm) altc = "'c cset \<Rightarrow> ('c \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 locale monad_altc_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes altc :: "('c, 'm) altc"
 begin
 
 definition fail :: "'m fail" where "fail = altc cempty (\<lambda>_. undefined)"
 
 end
 
 declare monad_altc_base.fail_def [code]
 
 locale monad_altc = monad return bind + monad_altc_base return bind altc
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and altc :: "('c, 'm) altc"
   +
   assumes bind_altc1: "\<And>C g f. bind (altc C g) f = altc C (\<lambda>c. bind (g c) f)"
   and altc_single: "\<And>x f. altc (csingle x) f = f x"
   and altc_cUNION: "\<And>C f g. altc (cUNION C f) g = altc C (\<lambda>x. altc (f x) g)"
   \<comment> \<open>We do not assume @{text altc_const} like for @{text sample} because the choice set might be empty\<close>
   and altc_parametric: "\<And>R. bi_unique R \<Longrightarrow> rel_fun (rel_cset R) (rel_fun (rel_fun R (=)) (=)) altc altc"
 begin
 
 lemma altc_cong: "cBall C (\<lambda>x. f x = g x) \<Longrightarrow> altc C f = altc C g"
   apply(rule altc_parametric[where R="eq_onp (\<lambda>x. cin x C)", THEN rel_funD, THEN rel_funD])
   subgoal by(simp add: bi_unique_def eq_onp_def)
   subgoal by(simp add: cset.rel_eq_onp eq_onp_same_args pred_cset_def cin_def)
   subgoal by(simp add: rel_fun_def eq_onp_def cBall_def cin_def)
   done
 
 lemma monad_fail [locale_witness]: "monad_fail return bind fail"
 proof
   show "bind fail f = fail" for f
     by(simp add: fail_def bind_altc1 cong: altc_cong)
 qed
 
 end
 
 text \<open>We can implement \<open>alt\<close> via \<open>altc\<close> only if we know that there are sufficiently
   many elements in the choice type @{typ 'c}. For the associativity law, we need at least
   three elements.\<close>
 
 locale monad_altc3 = monad_altc return bind altc + three "TYPE('c)"
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and altc :: "('c, 'm) altc"
 begin
 
 definition alt :: "'m alt"
 where "alt m1 m2 = altc (cinsert \<^bold>1 (csingle \<^bold>2)) (\<lambda>c. if c = \<^bold>1 then m1 else m2)"
 
 lemma monad_alt: "monad_alt return bind alt"
 proof
   show "bind (alt m m') f = alt (bind m f) (bind m' f)" for m m' f
     by(simp add: alt_def bind_altc1 if_distrib[where f="\<lambda>m. bind m _"])
 
   fix m1 m2 m3 :: 'm
   let ?C = "cUNION (cinsert \<^bold>1 (csingle \<^bold>2)) (\<lambda>c. if c = \<^bold>1 then cinsert \<^bold>1 (csingle \<^bold>2) else csingle \<^bold>3)"
   let ?D = "cUNION (cinsert \<^bold>1 (csingle \<^bold>2)) (\<lambda>c. if c = \<^bold>1 then csingle \<^bold>1 else cinsert \<^bold>2 (csingle \<^bold>3))"
   let ?f = "\<lambda>c. if c = \<^bold>1 then m1 else if c = \<^bold>2 then m2 else m3"
   have "alt (alt m1 m2) m3 = altc ?C ?f"
     by (simp only: altc_cUNION) (auto simp add: alt_def altc_single intro!: altc_cong)
   also have "?C = ?D" including cset.lifting by transfer(auto simp add: insert_commute)
   also have "altc ?D ?f = alt m1 (alt m2 m3)"
     apply (simp only: altc_cUNION)
     apply (clarsimp simp add: alt_def altc_single intro!: altc_cong)
     apply (rule altc_parametric [where R="conversep rel_12_23", THEN rel_funD, THEN rel_funD])
     subgoal by simp
     subgoal including cset.lifting by transfer
       (simp add: rel_set_def rel_12_23.simps)
     subgoal by (simp add: rel_fun_def rel_12_23.simps)
     done
   finally show "alt (alt m1 m2) m3 = alt m1 (alt m2 m3)" .
 qed
 
 end
 
 locale monad_state_altc =
   monad_state return bind get put +
   monad_altc return bind altc
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
   and altc :: "('c, 'm) altc"
   +
   assumes altc_get: "\<And>C f. altc C (\<lambda>c. get (f c)) = get (\<lambda>s. altc C (\<lambda>c. f c s))"
   and altc_put: "\<And>C f. altc C (\<lambda>c. put s (f c)) = put s (altc C f)"
 
 subsection \<open>Writer monad\<close>
 
 type_synonym ('w, 'm) tell = "'w \<Rightarrow> 'm \<Rightarrow> 'm"
 
 locale monad_writer_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes tell :: "('w, 'm) tell"
 
 locale monad_writer = monad_writer_base return bind tell + monad return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and tell :: "('w, 'm) tell"
   +
   assumes bind_tell: "\<And>w m f. bind (tell w m) f = tell w (bind m f)"
 
 subsection \<open>Resumption monad\<close>
 
 type_synonym ('o, 'i, 'm) pause = "'o \<Rightarrow> ('i \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 locale monad_resumption_base = monad_base return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   fixes pause :: "('o, 'i, 'm) pause"
 
 locale monad_resumption = monad_resumption_base return bind pause + monad return bind 
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   and pause :: "('o, 'i, 'm) pause"
   +
   assumes bind_pause: "bind (pause out c) f = pause out (\<lambda>i. bind (c i) f)"
 
 subsection \<open>Commutative monad\<close>
 
 locale monad_commute = monad return bind 
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   assumes bind_commute: "bind m (\<lambda>x. bind m' (f x)) = bind m' (\<lambda>y. bind m (\<lambda>x. f x y))"
 
 subsection \<open>Discardable monad\<close>
 
 locale monad_discard = monad return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   assumes bind_const: "bind m (\<lambda>_. m') = m'"
 
 subsection \<open>Duplicable monad\<close>
 
 locale monad_duplicate = monad return bind
   for return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
   +
   assumes bind_duplicate: "bind m (\<lambda>x. bind m (f x)) = bind m (\<lambda>x. f x x)"
 
 section \<open>Monad implementations\<close>
 
 subsection \<open>Identity monad\<close>
 
 text \<open>We need a type constructor such that we can overload the monad operations\<close>
 
 datatype 'a id = return_id ("extract": 'a)
 
 lemmas return_id_parametric = id.ctr_transfer
 
 lemma rel_id_unfold: 
   "rel_id A (return_id x) m' \<longleftrightarrow> (\<exists>x'. m' = return_id x' \<and> A x x')"
   "rel_id A m (return_id x') \<longleftrightarrow> (\<exists>x. m = return_id x \<and> A x x')"
   subgoal by(cases m'; simp)
   subgoal by(cases m; simp)
   done
 
 lemma rel_id_expand: "M (extract m) (extract m') \<Longrightarrow> rel_id M m m'"
   by(cases m; cases m'; simp)
 
 subsubsection \<open>Plain monad\<close>
 
 primrec bind_id :: "('a, 'a id) bind"
 where "bind_id (return_id x) f = f x"
 
 lemma extract_bind [simp]: "extract (bind_id x f) = extract (f (extract x))"
 by(cases x) simp
 
 lemma bind_id_parametric [transfer_rule]: includes lifting_syntax shows
   "(rel_id A ===> (A ===> rel_id A) ===> rel_id A) bind_id bind_id"
 unfolding bind_id_def by transfer_prover
 
 lemma monad_id [locale_witness]: "monad return_id bind_id"
 proof
   show "bind_id (bind_id x f) g = bind_id x (\<lambda>x. bind_id (f x) g)" 
     for x :: "'a id" and f :: "'a \<Rightarrow> 'a id" and g :: "'a \<Rightarrow> 'a id"
     by(rule id.expand) simp
   show "bind_id (return_id x) f = f x" for f :: "'a \<Rightarrow> 'a id" and x
     by(rule id.expand) simp
   show "bind_id x return_id = x" for x :: "'a id"
     by(rule id.expand) simp
 qed
 
 lemma monad_commute_id [locale_witness]: "monad_commute return_id bind_id"
 proof
   show "bind_id m (\<lambda>x. bind_id m' (f x)) = bind_id m' (\<lambda>y. bind_id m (\<lambda>x. f x y))" for m m' :: "'a id" and f
     by(rule id.expand) simp
 qed
 
 lemma monad_discard_id [locale_witness]: "monad_discard return_id bind_id"
 proof
   show "bind_id m (\<lambda>_. m') = m'" for m m' :: "'a id" by(rule id.expand) simp
 qed
 
 lemma monad_duplicate_id [locale_witness]: "monad_duplicate return_id bind_id"
 proof
   show "bind_id m (\<lambda>x. bind_id m (f x)) = bind_id m (\<lambda>x. f x x)" for m :: "'a id" and f
     by(rule id.expand) simp
 qed
 
 subsection \<open>Probability monad\<close>
 
 text \<open>We don't know of a sensible probability monad transformer, so we define the plain probability monad.\<close>
 
 type_synonym 'a prob = "'a pmf"
 
 lemma monad_prob [locale_witness]: "monad return_pmf bind_pmf"
 by unfold_locales(simp_all add: bind_assoc_pmf bind_return_pmf bind_return_pmf')
 
 lemma monad_prob_prob [locale_witness]: "monad_prob return_pmf bind_pmf bind_pmf"
   including lifting_syntax
 proof
   show "bind_pmf p (\<lambda>_. m) = m" for p :: "'b pmf" and m :: "'a prob"
     by(rule bind_pmf_const)
   show "bind_pmf (return_pmf x) f = f x" for f :: "'b \<Rightarrow> 'a prob" and x by(rule bind_return_pmf)
   show "bind_pmf (bind_pmf p f) g = bind_pmf p (\<lambda>x. bind_pmf (f x) g)"
     for p :: "'b pmf" and f :: "'b \<Rightarrow> 'b pmf" and g :: "'b \<Rightarrow> 'a prob"
     by(rule bind_assoc_pmf)
   show "bind_pmf p (\<lambda>x. bind_pmf q (f x)) = bind_pmf q (\<lambda>y. bind_pmf p (\<lambda>x. f x y))"
     for p q :: "'b pmf" and f :: "'b \<Rightarrow> 'b \<Rightarrow> 'a prob" by(rule bind_commute_pmf)
   show "bind_pmf (bind_pmf p f) g = bind_pmf p (\<lambda>x. bind_pmf (f x) g)"
     for p :: "'b pmf" and f :: "'b \<Rightarrow> 'a prob" and g :: "'a \<Rightarrow> 'a prob"
     by(simp add: bind_assoc_pmf)
   show "bind_pmf m (\<lambda>y. bind_pmf p (f y)) = bind_pmf p (\<lambda>x. bind_pmf m (\<lambda>y. f y x))"
     for m :: "'a prob" and p :: "'b pmf" and f :: "'a \<Rightarrow> 'b \<Rightarrow> 'a prob"
     by(rule bind_commute_pmf)
   show "(rel_pmf R ===> (R ===> (=)) ===> (=)) bind_pmf bind_pmf" for R :: "'b \<Rightarrow> 'b \<Rightarrow> bool" 
     by transfer_prover
 qed
 
 lemma monad_commute_prob [locale_witness]: "monad_commute return_pmf bind_pmf"
 proof
   show "bind_pmf m (\<lambda>x. bind_pmf m' (f x)) = bind_pmf m' (\<lambda>y. bind_pmf m (\<lambda>x. f x y))"
     for m m' :: "'a prob" and f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a prob"
     by(rule bind_commute_pmf)
 qed
 
 lemma monad_discard_prob [locale_witness]: "monad_discard return_pmf bind_pmf"
 proof
   show "bind_pmf m (\<lambda>_. m') = m'" for m m' :: "'a pmf" by(simp)
 qed
 
 subsection \<open>Resumption\<close>
 
 text \<open>
   We cannot define a resumption monad transformer because the codatatype recursion would have to
   go through a type variable. If we plug in something like unbounded non-determinism, then the
   HOL type does not exist.
 \<close>
 
 codatatype ('o, 'i, 'a) resumption = is_Done: Done (result: 'a) | Pause ("output": 'o) (resume: "'i \<Rightarrow> ('o, 'i, 'a) resumption")
 
 subsubsection \<open>Plain monad\<close>
 
 definition return_resumption :: "'a \<Rightarrow> ('o, 'i, 'a) resumption"
 where "return_resumption = Done"
 
 primcorec bind_resumption :: "('o, 'i, 'a) resumption \<Rightarrow> ('a \<Rightarrow> ('o, 'i, 'a) resumption) \<Rightarrow> ('o, 'i, 'a) resumption"
 where "bind_resumption m f = (if is_Done m then f (result m) else Pause (output m) (\<lambda>i. bind_resumption (resume m i) f))"
 
 definition pause_resumption :: "'o \<Rightarrow> ('i \<Rightarrow> ('o, 'i, 'a) resumption) \<Rightarrow> ('o, 'i, 'a) resumption"
 where "pause_resumption = Pause"
 
 lemma is_Done_return_resumption [simp]: "is_Done (return_resumption x)"
 by(simp add: return_resumption_def)
 
 lemma result_return_resumption [simp]: "result (return_resumption x) = x"
 by(simp add: return_resumption_def)
 
 lemma monad_resumption [locale_witness]: "monad return_resumption bind_resumption"
 proof
   show "bind_resumption (bind_resumption x f) g = bind_resumption x (\<lambda>y. bind_resumption (f y) g)"
     for x :: "('o, 'i, 'a) resumption" and f g
     by(coinduction arbitrary: x f g rule: resumption.coinduct_strong) auto
   show "bind_resumption (return_resumption x) f = f x" for x and f :: "'a \<Rightarrow> ('o, 'i, 'a) resumption"
     by(rule resumption.expand)(simp_all add: return_resumption_def)
   show "bind_resumption x return_resumption = x" for x :: "('o, 'i, 'a) resumption"
     by(coinduction arbitrary: x rule: resumption.coinduct_strong) auto
 qed
 
 lemma monad_resumption_resumption [locale_witness]:
   "monad_resumption return_resumption bind_resumption pause_resumption"
 proof
   show "bind_resumption (pause_resumption out c) f = pause_resumption out (\<lambda>i. bind_resumption (c i) f)"
     for out c and f :: "'a \<Rightarrow> ('o, 'i, 'a) resumption"
     by(rule resumption.expand)(simp_all add: pause_resumption_def)
 qed
 
 subsection \<open>Failure and exception monad transformer\<close>
 
 text \<open>
   The phantom type variable @{typ 'a} is needed to avoid hidden polymorphism when overloading the
   monad operations for the failure monad transformer.
 \<close>
 
 datatype (plugins del: transfer) (phantom_optionT: 'a, set_optionT: 'm) optionT =
   OptionT (run_option: 'm)
   for rel: rel_optionT' 
       map: map_optionT'
 
 text \<open>
   We define our own relator and mapper such that the phantom variable does not need any relation.
 \<close>
 
 lemma phantom_optionT [simp]: "phantom_optionT x = {}"
 by(cases x) simp
 
 context includes lifting_syntax begin
 
 lemma rel_optionT'_phantom: "rel_optionT' A = rel_optionT' top"
 by(auto 4 4 intro: optionT.rel_mono antisym optionT.rel_mono_strong)
 
 lemma map_optionT'_phantom: "map_optionT' f = map_optionT' undefined"
 by(auto 4 4 intro: optionT.map_cong)
 
 definition map_optionT :: "('m \<Rightarrow> 'm') \<Rightarrow> ('a, 'm) optionT \<Rightarrow> ('b, 'm') optionT"
 where "map_optionT = map_optionT' undefined"
 
 definition rel_optionT :: "('m \<Rightarrow> 'm' \<Rightarrow> bool) \<Rightarrow> ('a, 'm) optionT \<Rightarrow> ('b, 'm') optionT \<Rightarrow> bool"
 where "rel_optionT = rel_optionT' top"
 
 lemma rel_optionTE:
   assumes "rel_optionT M m m'"
   obtains x y where "m = OptionT x" "m' = OptionT y" "M x y"
 using assms by(cases m; cases m'; simp add: rel_optionT_def)
 
 lemma rel_optionT_simps [simp]: "rel_optionT M (OptionT m) (OptionT m') \<longleftrightarrow> M m m'"
 by(simp add: rel_optionT_def)
 
 lemma rel_optionT_eq [relator_eq]: "rel_optionT (=) = (=)"
 by(auto simp add: fun_eq_iff rel_optionT_def intro: optionT.rel_refl_strong elim: optionT.rel_cases)
 
 lemma rel_optionT_mono [relator_mono]: "rel_optionT A \<le> rel_optionT B" if "A \<le> B"
 by(simp add: rel_optionT_def optionT.rel_mono that)
 
 lemma rel_optionT_distr [relator_distr]: "rel_optionT A OO rel_optionT B = rel_optionT (A OO B)"
 by(simp add: rel_optionT_def optionT.rel_compp[symmetric])
 
 lemma rel_optionT_Grp: "rel_optionT (BNF_Def.Grp A f) = BNF_Def.Grp {x. set_optionT x \<subseteq> A} (map_optionT f)"
 by(simp add: rel_optionT_def rel_optionT'_phantom[of "BNF_Def.Grp UNIV undefined", symmetric] optionT.rel_Grp map_optionT_def)
 
 lemma OptionT_parametric [transfer_rule]: "(M ===> rel_optionT M) OptionT OptionT"
 by(simp add: rel_fun_def rel_optionT_def)
 
 lemma run_option_parametric [transfer_rule]: "(rel_optionT M ===> M) run_option run_option"
 by(auto simp add: rel_fun_def rel_optionT_def elim: optionT.rel_cases)
 
 lemma case_optionT_parametric [transfer_rule]:
   "((M ===> X) ===> rel_optionT M ===> X) case_optionT case_optionT"
 by(auto simp add: rel_fun_def rel_optionT_def split: optionT.split)
 
 lemma rec_optionT_parametric [transfer_rule]:
   "((M ===> X) ===> rel_optionT M ===> X) rec_optionT rec_optionT"
 by(auto simp add: rel_fun_def elim: rel_optionTE)
 
 end
 
 subsubsection \<open>Plain monad, failure, and exceptions\<close>
 
 context
   fixes return :: "('a option, 'm) return"
   and bind :: "('a option, 'm) bind"
 begin
 
 definition return_option :: "('a, ('a, 'm) optionT) return"
 where "return_option x = OptionT (return (Some x))"
 
 primrec bind_option :: "('a, ('a, 'm) optionT) bind"
 where [code_unfold, monad_unfold]:
   "bind_option (OptionT x) f = 
    OptionT (bind x (\<lambda>x. case x of None \<Rightarrow> return (None :: 'a option) | Some y \<Rightarrow> run_option (f y)))"
 
 definition fail_option :: "('a, 'm) optionT fail"
 where [code_unfold, monad_unfold]: "fail_option = OptionT (return None)"
 
 definition catch_option :: "('a, 'm) optionT catch"
 where "catch_option m h = OptionT (bind (run_option m) (\<lambda>x. if x = None then run_option h else return x))"
 
 lemma run_bind_option:
   "run_option (bind_option x f) = bind (run_option x) (\<lambda>x. case x of None \<Rightarrow> return None | Some y \<Rightarrow> run_option (f y))"
 by(cases x) simp
 
 lemma run_return_option [simp]: "run_option (return_option x) = return (Some x)"
 by(simp add: return_option_def)
 
 lemma run_fail_option [simp]: "run_option fail_option = return None"
 by(simp add: fail_option_def)
 
 lemma run_catch_option [simp]: 
   "run_option (catch_option m1 m2) = bind (run_option m1) (\<lambda>x. if x = None then run_option m2 else return x)"
 by(simp add: catch_option_def)
 
 context
   assumes monad: "monad return bind"
 begin
 
 interpretation monad return bind by(rule monad)
 
 lemma monad_optionT [locale_witness]: "monad return_option bind_option" (is "monad ?return ?bind")
 proof
   show "?bind (?bind x f) g = ?bind x (\<lambda>x. ?bind (f x) g)"  for x f g
     by(rule optionT.expand)(auto simp add: bind_assoc run_bind_option return_bind intro!: arg_cong2[where f=bind] split: option.split)
   show "?bind (?return x) f = f x" for f x
     by(rule optionT.expand)(simp add: run_bind_option return_bind return_option_def)
   show "?bind x ?return = x" for x
     by(rule optionT.expand)(simp add: run_bind_option option.case_distrib[symmetric] case_option_id bind_return cong del: option.case_cong)
 qed
 
 lemma monad_fail_optionT [locale_witness]:
   "monad_fail return_option bind_option fail_option"
 proof
   show "bind_option fail_option f = fail_option" for f
     by(rule optionT.expand)(simp add: run_bind_option return_bind)
 qed
 
 lemma monad_catch_optionT [locale_witness]:
   "monad_catch return_option bind_option fail_option catch_option"
 proof
   show "catch_option (return_option x) m = return_option x" for x m
     by(rule optionT.expand)(simp add: return_bind)
   show "catch_option fail_option m = m" for m
     by(rule optionT.expand)(simp add: return_bind)
   show "catch_option m fail_option = m" for m
     by(rule optionT.expand)(simp add: bind_return if_distrib[where f="return", symmetric] cong del: if_weak_cong)
    show "catch_option (catch_option m m') m'' = catch_option m (catch_option m' m'')" for m m' m''
     by(rule optionT.expand)(auto simp add: bind_assoc fun_eq_iff return_bind intro!: arg_cong2[where f=bind])
 qed
 
 end
 
 subsubsection \<open>Reader\<close>
 
 context
   fixes ask :: "('r, 'm) ask"
 begin
 
 definition ask_option :: "('r, ('a, 'm) optionT) ask" 
 where [code_unfold, monad_unfold]: "ask_option f = OptionT (ask (\<lambda>r. run_option (f r)))"
 
 lemma run_ask_option [simp]: "run_option (ask_option f) = ask (\<lambda>r. run_option (f r))"
 by(simp add: ask_option_def)
 
 lemma monad_reader_optionT [locale_witness]:
   assumes "monad_reader return bind ask"
   shows "monad_reader return_option bind_option ask_option"
 proof -
   interpret monad_reader return bind ask by(fact assms)
   show ?thesis
   proof
     show "ask_option (\<lambda>r. ask_option (f r)) = ask_option (\<lambda>r. f r r)" for f
       by(rule optionT.expand)(simp add: ask_ask)
     show "ask_option (\<lambda>_. x) = x" for x
       by(rule optionT.expand)(simp add: ask_const)
     show "bind_option (ask_option f) g = ask_option (\<lambda>r. bind_option (f r) g)" for f g
       by(rule optionT.expand)(simp add: bind_ask run_bind_option)
     show "bind_option m (\<lambda>x. ask_option (f x)) = ask_option (\<lambda>r. bind_option m (\<lambda>x. f x r))" for m f
       by(rule optionT.expand)(auto simp add: bind_ask2[symmetric] run_bind_option ask_const del: ext intro!: arg_cong2[where f=bind] ext split: option.split)
   qed
 qed
 
 end
 
 subsubsection \<open>State\<close>
 
 context
   fixes get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
 begin
 
 definition get_option :: "('s, ('a, 'm) optionT) get"
 where "get_option f = OptionT (get (\<lambda>s. run_option (f s)))"
 
 primrec put_option :: "('s, ('a, 'm) optionT) put"
 where "put_option s (OptionT m) = OptionT (put s m)"
 
 lemma run_get_option [simp]:
   "run_option (get_option f) = get (\<lambda>s. run_option (f s))"
 by(simp add: get_option_def)
 
 lemma run_put_option [simp]:
   "run_option (put_option s m) = put s (run_option m)"
 by(cases m)(simp)
 
 context
   assumes state: "monad_state return bind get put"
 begin
 
 interpretation monad_state return bind get put by(fact state)
 
 lemma monad_state_optionT [locale_witness]:
   "monad_state return_option bind_option get_option put_option"
 proof
   show "put_option s (get_option f) = put_option s (f s)" for s f
     by(rule optionT.expand)(simp add: put_get)
   show "get_option (\<lambda>s. get_option (f s)) = get_option (\<lambda>s. f s s)" for f
     by(rule optionT.expand)(simp add: get_get)
   show "put_option s (put_option s' m) = put_option s' m" for s s' m
     by(rule optionT.expand)(simp add: put_put)
   show "get_option (\<lambda>s. put_option s m) = m" for m
     by(rule optionT.expand)(simp add: get_put)
   show "get_option (\<lambda>_. m) = m" for m
     by(rule optionT.expand)(simp add: get_const)
   show "bind_option (get_option f) g = get_option (\<lambda>s. bind_option (f s) g)" for f g
     by(rule optionT.expand)(simp add: bind_get run_bind_option)
   show "bind_option (put_option s m) f = put_option s (bind_option m f)" for s m f
     by(rule optionT.expand)(simp add: bind_put run_bind_option)
 qed
 
 lemma monad_catch_state_optionT [locale_witness]:
   "monad_catch_state return_option bind_option fail_option catch_option get_option put_option"
 proof
   show "catch_option (get_option f) m = get_option (\<lambda>s. catch_option (f s) m)" for f m
     by(rule optionT.expand)(simp add: bind_get)
   show "catch_option (put_option s m) m' = put_option s (catch_option m m')" for s m m'
     by(rule optionT.expand)(simp add: bind_put)
 qed
 
 end
 
 subsubsection \<open>Probability\<close>
 
 definition altc_sample_option :: "('x \<Rightarrow> ('b \<Rightarrow> 'm) \<Rightarrow> 'm) \<Rightarrow> 'x \<Rightarrow> ('b \<Rightarrow> ('a, 'm) optionT) \<Rightarrow> ('a, 'm) optionT"
   where "altc_sample_option altc_sample p f = OptionT (altc_sample p (\<lambda>x. run_option (f x)))"
 
 lemma run_altc_sample_option [simp]: "run_option (altc_sample_option altc_sample p f) = altc_sample p (\<lambda>x. run_option (f x))"
 by(simp add: altc_sample_option_def)
 
 context
   fixes sample :: "('p, 'm) sample"
 begin
 
 abbreviation sample_option :: "('p, ('a, 'm) optionT) sample"
 where "sample_option \<equiv> altc_sample_option sample"
 
 lemma monad_prob_optionT [locale_witness]:
   assumes "monad_prob return bind sample"
   shows "monad_prob return_option bind_option sample_option"
 proof -
   interpret monad_prob return bind sample by(fact assms)
   note sample_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "sample_option p (\<lambda>_. x) = x" for p x
       by(rule optionT.expand)(simp add: sample_const)
     show "sample_option (return_pmf x) f = f x" for f x
       by(rule optionT.expand)(simp add: sample_return_pmf)
     show "sample_option (bind_pmf p f) g = sample_option p (\<lambda>x. sample_option (f x) g)" for p f g
       by(rule optionT.expand)(simp add: sample_bind_pmf)
     show "sample_option p (\<lambda>x. sample_option q (f x)) = sample_option q (\<lambda>y. sample_option p (\<lambda>x. f x y))" for p q f
       by(rule optionT.expand)(auto intro!: sample_commute)
     show "bind_option (sample_option p f) g = sample_option p (\<lambda>x. bind_option (f x) g)" for p f g
       by(rule optionT.expand)(auto simp add: bind_sample1 run_bind_option)
     show "bind_option m (\<lambda>y. sample_option p (f y)) = sample_option p (\<lambda>x. bind_option m (\<lambda>y. f y x))" for m p f
       by(rule optionT.expand)(auto simp add: bind_sample2[symmetric] run_bind_option sample_const del: ext intro!: arg_cong2[where f=bind] ext split: option.split)
     show  "(rel_pmf R ===> (R ===> (=)) ===> (=)) sample_option sample_option" 
       if [transfer_rule]: "bi_unique R" for R
       unfolding altc_sample_option_def by transfer_prover
   qed
 qed
 
 lemma monad_state_prob_optionT [locale_witness]:
   assumes "monad_state_prob return bind get put sample"
   shows "monad_state_prob return_option bind_option get_option put_option sample_option"
 proof -
   interpret monad_state_prob return bind get put sample by fact
   show ?thesis
   proof
     show "sample_option p (\<lambda>x. get_option (f x)) = get_option (\<lambda>s. sample_option p (\<lambda>x. f x s))" for p f
       by(rule optionT.expand)(simp add: sample_get)
   qed
 qed
 
 end
 
 subsubsection \<open>Writer\<close>
 
 context
   fixes tell :: "('w, 'm) tell"
 begin
 
 definition tell_option :: "('w, ('a, 'm) optionT) tell" 
 where "tell_option w m = OptionT (tell w (run_option m))"
 
 lemma run_tell_option [simp]: "run_option (tell_option w m) = tell w (run_option m)"
 by(simp add: tell_option_def)
 
 lemma monad_writer_optionT [locale_witness]:
   assumes "monad_writer return bind tell"
   shows "monad_writer return_option bind_option tell_option"
 proof -
   interpret monad_writer return bind tell by fact
   show ?thesis
   proof
     show "bind_option (tell_option w m) f = tell_option w (bind_option m f)" for w m f
       by(rule optionT.expand)(simp add: run_bind_option bind_tell)
   qed
 qed
 
 end
 
 subsubsection \<open>Binary Non-determinism\<close>
 
 context
   fixes alt :: "'m alt"
 begin
 
 definition alt_option :: "('a, 'm) optionT alt"
 where "alt_option m1 m2 = OptionT (alt (run_option m1) (run_option m2))"
 
 lemma run_alt_option [simp]: "run_option (alt_option m1 m2) = alt (run_option m1) (run_option m2)"
 by(simp add: alt_option_def)
 
 lemma monad_alt_optionT [locale_witness]:
   assumes "monad_alt return bind alt"
   shows "monad_alt return_option bind_option alt_option"
 proof -
   interpret monad_alt return bind alt by fact
   show ?thesis
   proof
     show "alt_option (alt_option m1 m2) m3 = alt_option m1 (alt_option m2 m3)" for m1 m2 m3
       by(rule optionT.expand)(simp add: alt_assoc)
     show "bind_option (alt_option m m') f = alt_option (bind_option m f) (bind_option m' f)" for m m' f
       by(rule optionT.expand)(simp add: bind_alt1 run_bind_option)
   qed
 qed
 
 text \<open>
   The @{term fail} of @{typ "(_, _) optionT"} does not combine with @{term "alt"} of the inner monad
   because @{typ "(_, _) optionT"} injects failures with @{term "return None"} into the inner monad.
 \<close>
 
 lemma monad_state_alt_optionT [locale_witness]:
   assumes "monad_state_alt return bind get put alt"
   shows "monad_state_alt return_option bind_option get_option put_option alt_option"
 proof -
   interpret monad_state_alt return bind get put alt by fact
   show ?thesis
   proof
     show "alt_option (get_option f) (get_option g) = get_option (\<lambda>x. alt_option (f x) (g x))"
       for f g by(rule optionT.expand)(simp add: alt_get)
     show "alt_option (put_option s m) (put_option s m') = put_option s (alt_option m m')"
       for s m m' by(rule optionT.expand)(simp add: alt_put)
   qed
 qed
 
 end
 
 subsubsection \<open>Countable Non-determinism\<close>
 
 context
   fixes altc :: "('c, 'm) altc"
 begin
 
 abbreviation altc_option :: "('c, ('a, 'm) optionT) altc"
 where "altc_option \<equiv> altc_sample_option altc"
 
 lemma monad_altc_optionT [locale_witness]:
   assumes "monad_altc return bind altc"
   shows "monad_altc return_option bind_option altc_option"
 proof -
   interpret monad_altc return bind altc by fact
   note altc_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "bind_option (altc_option C g) f = altc_option C (\<lambda>c. bind_option (g c) f)" for C g f
       by(rule optionT.expand)(simp add: run_bind_option bind_altc1 o_def)
     show "altc_option (csingle x) f = f x" for x f
       by(rule optionT.expand)(simp add: bind_altc1 altc_single)
     show "altc_option (cUNION C f) g = altc_option C (\<lambda>x. altc_option (f x) g)" for C f g
       by(rule optionT.expand)(simp add: bind_altc1 altc_cUNION o_def)
     show "(rel_cset R ===> (R ===> (=)) ===> (=)) altc_option altc_option"
       if [transfer_rule]: "bi_unique R" for R
       unfolding altc_sample_option_def by transfer_prover
   qed
 qed
 
 lemma monad_altc3_optionT [locale_witness]:
   assumes "monad_altc3 return bind altc"
   shows "monad_altc3 return_option bind_option altc_option"
 proof -
   interpret monad_altc3 return bind altc by fact
   show ?thesis ..
 qed
 
 lemma monad_state_altc_optionT [locale_witness]:
   assumes "monad_state_altc return bind get put altc"
   shows "monad_state_altc return_option bind_option get_option put_option altc_option"
 proof -
   interpret monad_state_altc return bind get put altc by fact
   show ?thesis
   proof
     show "altc_option C (\<lambda>c. get_option (f c)) = get_option (\<lambda>s. altc_option C (\<lambda>c. f c s))"
       for C f by(rule optionT.expand)(simp add: o_def altc_get)
     show "altc_option C (\<lambda>c. put_option s (f c)) = put_option s (altc_option C f)"
       for C s f by(rule optionT.expand)(simp add: o_def altc_put)
   qed
 qed
 
 end
 
 end
 
 subsubsection \<open>Resumption\<close>
 
 context
   fixes pause :: "('o, 'i, 'm) pause"
 begin
 
 definition pause_option :: "('o, 'i, ('a, 'm) optionT) pause"
 where "pause_option out c = OptionT (pause out (\<lambda>i. run_option (c i)))"
 
 lemma run_pause_option [simp]: "run_option (pause_option out c) = pause out (\<lambda>i. run_option (c i))"
 by(simp add: pause_option_def)
 
 lemma monad_resumption_optionT [locale_witness]:
   assumes "monad_resumption return bind pause"
   shows "monad_resumption return_option bind_option pause_option"
 proof -
   interpret monad_resumption return bind pause by fact
   show ?thesis
   proof
     show "bind_option (pause_option out c) f = pause_option out (\<lambda>i. bind_option (c i) f)" for out c f
       by(rule optionT.expand)(simp add: bind_pause run_bind_option)
   qed
 qed
 
 end
 
 subsubsection \<open>Commutativity\<close>
 
 lemma monad_commute_optionT [locale_witness]:
   assumes "monad_commute return bind"
   and "monad_discard return bind"
   shows "monad_commute return_option bind_option"
 proof -
   interpret monad_commute return bind by fact
   interpret monad_discard return bind by fact
   show ?thesis
   proof
     fix m m' f
     have "run_option (bind_option m (\<lambda>x. bind_option m' (f x))) = 
       bind (run_option m) (\<lambda>x. bind (run_option m') (\<lambda>y. case (x, y) of (Some x', Some y') \<Rightarrow> run_option (f x' y') | _ \<Rightarrow> return None))"
       by(auto simp add: run_bind_option bind_const cong del: option.case_cong del: ext intro!: arg_cong2[where f=bind] ext split: option.split)
     also have "\<dots> = bind (run_option m') (\<lambda>y. bind (run_option m) (\<lambda>x. case (x, y) of (Some x', Some y') \<Rightarrow> run_option (f x' y') | _ \<Rightarrow> return None))"
       by(rule bind_commute)
     also have "\<dots> = run_option (bind_option m' (\<lambda>y. bind_option m (\<lambda>x. f x y)))"
       by(auto simp add: run_bind_option bind_const case_option_collapse cong del: option.case_cong del: ext intro!: arg_cong2[where f=bind] ext split: option.split)
     finally show "bind_option m (\<lambda>x. bind_option m' (f x)) = bind_option m' (\<lambda>y. bind_option m (\<lambda>x. f x y))"
       by(rule optionT.expand)
   qed
 qed
 
 subsubsection \<open>Duplicability\<close>
 
 lemma monad_duplicate_optionT [locale_witness]:
   assumes "monad_duplicate return bind"
     and "monad_discard return bind"
   shows "monad_duplicate return_option bind_option"
 proof -
   interpret monad_duplicate return bind by fact
   interpret monad_discard return bind by fact
   show ?thesis
   proof
     fix m f
     have "run_option (bind_option m (\<lambda>x. bind_option m (f x))) =
           bind (run_option m) (\<lambda>x. bind (run_option m) (\<lambda>y. case x of None \<Rightarrow> return None | Some x' \<Rightarrow> (case y of None \<Rightarrow> return None | Some y' \<Rightarrow> run_option (f x' y'))))"
       by(auto intro!: arg_cong2[where f=bind] simp add: fun_eq_iff bind_const run_bind_option split: option.split)
     also have "\<dots> = run_option (bind_option m (\<lambda>x. f x x))"
       by(simp add: bind_duplicate run_bind_option cong: option.case_cong)
     finally show "bind_option m (\<lambda>x. bind_option m (f x)) = bind_option m (\<lambda>x. f x x)"
       by(rule optionT.expand)
   qed
 qed
 
 end
 
 subsubsection \<open>Parametricity\<close>
 
 context includes lifting_syntax begin
 
 lemma return_option_parametric [transfer_rule]:
   "((rel_option A ===> M) ===> A ===> rel_optionT M) return_option return_option"
 unfolding return_option_def by transfer_prover
 
 lemma bind_option_parametric [transfer_rule]:
   "((rel_option A ===> M) ===> (M ===> (rel_option A ===> M) ===> M)
    ===> rel_optionT M ===> (A ===> rel_optionT M) ===> rel_optionT M)
    bind_option bind_option"
 unfolding bind_option_def by transfer_prover
 
 lemma fail_option_parametric [transfer_rule]:
   "((rel_option A ===> M) ===> rel_optionT M) fail_option fail_option"
 unfolding fail_option_def by transfer_prover
 
 lemma catch_option_parametric [transfer_rule]:
   "((rel_option A ===> M) ===> (M ===> (rel_option A ===> M) ===> M)
    ===> rel_optionT M ===> rel_optionT M ===> rel_optionT M)
   catch_option catch_option"
   unfolding catch_option_def Option.is_none_def[symmetric] by transfer_prover
 
 lemma ask_option_parametric [transfer_rule]:
   "(((R ===> M) ===> M) ===> (R ===> rel_optionT M) ===> rel_optionT M) ask_option ask_option"
 unfolding ask_option_def by transfer_prover
 
 lemma get_option_parametric [transfer_rule]:
   "(((S ===> M) ===> M) ===> (S ===> rel_optionT M) ===> rel_optionT M) get_option get_option"
 unfolding get_option_def by transfer_prover
 
 lemma put_option_parametric [transfer_rule]:
   "((S ===> M ===> M) ===> S ===> rel_optionT M ===> rel_optionT M) put_option put_option"
 unfolding put_option_def by transfer_prover
 
 lemma altc_sample_option_parametric [transfer_rule]:
   "((A ===> (P ===> M) ===> M) ===> A ===> (P ===> rel_optionT M) ===> rel_optionT M)
    altc_sample_option altc_sample_option"
 unfolding altc_sample_option_def by transfer_prover
 
 lemma alt_option_parametric [transfer_rule]:
   "((M ===> M ===> M) ===> rel_optionT M ===> rel_optionT M ===> rel_optionT M) alt_option alt_option"
 unfolding alt_option_def by transfer_prover
 
 lemma tell_option_parametric [transfer_rule]:
   "((W ===> M ===> M) ===> W ===> rel_optionT M ===> rel_optionT M) tell_option tell_option"
 unfolding tell_option_def by transfer_prover
 
 lemma pause_option_parametric [transfer_rule]:
   "((Out ===> (In ===> M) ===> M) ===> Out ===> (In ===> rel_optionT M) ===> rel_optionT M)
    pause_option pause_option"
 unfolding pause_option_def by transfer_prover
 
 end
 
 subsection \<open>Reader monad transformer\<close>
 
 datatype ('r, 'm) envT = EnvT (run_env: "'r \<Rightarrow> 'm")
 
 context includes lifting_syntax begin 
 
 definition rel_envT :: "('r \<Rightarrow> 'r' \<Rightarrow> bool) \<Rightarrow> ('m \<Rightarrow> 'm' \<Rightarrow> bool) \<Rightarrow> ('r, 'm) envT \<Rightarrow> ('r', 'm') envT \<Rightarrow> bool"
 where "rel_envT R M = BNF_Def.vimage2p run_env run_env (R ===> M)"
 
 lemma rel_envTI [intro!]: "(R ===> M) f g \<Longrightarrow> rel_envT R M (EnvT f) (EnvT g)"
 by(simp add: rel_envT_def BNF_Def.vimage2p_def)
 
 lemma rel_envT_simps: "rel_envT R M (EnvT f) (EnvT g) \<longleftrightarrow> (R ===> M) f g"
 by(simp add: rel_envT_def BNF_Def.vimage2p_def)
 
 lemma rel_envTE [cases pred]:
   assumes "rel_envT R M m m'"
   obtains f g where "m = EnvT f" "m' = EnvT g" "(R ===> M) f g"
 using assms by(cases m; cases m'; auto  simp add: rel_envT_simps)
 
 lemma rel_envT_eq [relator_eq]: "rel_envT (=) (=) = (=)"
 by(auto simp add: rel_envT_def rel_fun_eq BNF_Def.vimage2p_def fun_eq_iff intro: envT.expand)
 
 lemma rel_envT_mono [relator_mono]: "\<lbrakk> R \<le> R'; M \<le> M' \<rbrakk> \<Longrightarrow> rel_envT R' M \<le> rel_envT R M'"
 by(simp add: rel_envT_def predicate2I vimage2p_mono fun_mono)
 
 lemma EnvT_parametric [transfer_rule]: "((R ===> M) ===> rel_envT R M) EnvT EnvT"
 by(simp add: rel_funI rel_envT_simps)
 
 lemma run_env_parametric [transfer_rule]: "(rel_envT R M ===> R ===> M) run_env run_env"
 by(auto elim!: rel_envTE)
 
 lemma rec_envT_parametric [transfer_rule]:
   "(((R ===> M) ===> X) ===> rel_envT R M ===> X) rec_envT rec_envT"
 by(auto 4 4 elim!: rel_envTE dest: rel_funD)
 
 lemma case_envT_parametric [transfer_rule]:
   "(((R ===> M) ===> X) ===> rel_envT R M ===> X) case_envT case_envT"
 by(auto 4 4 elim!: rel_envTE dest: rel_funD)
 
 end
 
 subsubsection \<open>Plain monad and ask\<close>
 
 context
   fixes return :: "('a, 'm) return"
   and bind :: "('a, 'm) bind"
 begin
 
 definition return_env :: "('a, ('r, 'm) envT) return"
 where "return_env x = EnvT (\<lambda>_. return x)"
 
 primrec bind_env :: "('a, ('r, 'm) envT) bind"
 where "bind_env (EnvT x) f = EnvT (\<lambda>r. bind (x r) (\<lambda>y. run_env (f y) r))"
 
 definition ask_env :: "('r, ('r, 'm) envT) ask"
 where "ask_env f = EnvT (\<lambda>r. run_env (f r) r)"
 
 lemma run_bind_env [simp]: "run_env (bind_env x f) r = bind (run_env x r) (\<lambda>y. run_env (f y) r)"
 by(cases x) simp
 
 lemma run_return_env [simp]: "run_env (return_env x) r = return x"
 by(simp add: return_env_def)
 
 lemma run_ask_env [simp]: "run_env (ask_env f) r = run_env (f r) r"
 by(simp add: ask_env_def)
 
 context
   assumes monad: "monad return bind"
 begin
 
 interpretation monad return "bind :: ('a, 'm) bind" by(fact monad)
 
 lemma monad_envT [locale_witness]: "monad return_env bind_env"
 proof
   show "bind_env (bind_env x f) g = bind_env x (\<lambda>x. bind_env (f x) g)" 
     for x :: "('r, 'm) envT" and f :: "'a \<Rightarrow> ('r, 'm) envT" and g :: "'a \<Rightarrow> ('r, 'm) envT"
     by(rule envT.expand)(auto simp add: bind_assoc return_bind)
   show "bind_env (return_env x) f = f x" for f :: "'a \<Rightarrow> ('r, 'm) envT" and x
     by(rule envT.expand)(simp add: return_bind return_env_def)
   show "bind_env x (return_env :: ('a, ('r, 'm) envT) return) = x" for x :: "('r, 'm) envT"
     by(rule envT.expand)(simp add: bind_return fun_eq_iff)
 qed
 
 lemma monad_reader_envT [locale_witness]:
   "monad_reader return_env bind_env ask_env"
 proof
   show "ask_env (\<lambda>r. ask_env (f r)) = ask_env (\<lambda>r. f r r)" for f :: "'r \<Rightarrow> 'r \<Rightarrow> ('r, 'm) envT"
     by(rule envT.expand)(auto simp add: fun_eq_iff)
   show "ask_env (\<lambda>_. x) = x" for x :: "('r, 'm) envT"
     by(rule envT.expand)(auto simp add: fun_eq_iff)
   show "bind_env (ask_env f) g = ask_env (\<lambda>r. bind_env (f r) g)" for f :: "'r \<Rightarrow> ('r, 'm) envT" and g
     by(rule envT.expand)(auto simp add: fun_eq_iff)
   show "bind_env m (\<lambda>x. ask_env (f x)) = ask_env (\<lambda>r. bind_env m (\<lambda>x. f x r))" for m :: "('r, 'm) envT" and f
     by(rule envT.expand)(auto simp add: fun_eq_iff)
 qed
 
 end
 
 subsubsection \<open>Failure\<close>
 
 context
   fixes fail :: "'m fail"
 begin
 
 definition fail_env :: "('r, 'm) envT fail"
 where "fail_env = EnvT (\<lambda>r. fail)"
 
 lemma run_fail_env [simp]: "run_env fail_env r = fail"
 by(simp add: fail_env_def)
 
 lemma monad_fail_envT [locale_witness]:
   assumes "monad_fail return bind fail"
   shows "monad_fail return_env bind_env fail_env"
 proof -
   interpret monad_fail return bind fail by(fact assms)
   have "bind_env fail_env f = fail_env" for f :: "'a \<Rightarrow> ('r, 'm) envT"
     by(rule envT.expand)(simp add: fun_eq_iff fail_bind)
   then show ?thesis by unfold_locales
 qed
 
 context
   fixes catch :: "'m catch"
 begin
 
 definition catch_env :: "('r, 'm) envT catch"
 where "catch_env m1 m2 = EnvT (\<lambda>r. catch (run_env m1 r) (run_env m2 r))"
 
 lemma run_catch_env [simp]: "run_env (catch_env m1 m2) r = catch (run_env m1 r) (run_env m2 r)"
 by(simp add: catch_env_def)
 
 lemma monad_catch_envT [locale_witness]:
   assumes "monad_catch return bind fail catch"
   shows "monad_catch return_env bind_env fail_env catch_env"
 proof -
   interpret monad_catch return bind fail catch by fact
   show ?thesis
   proof
     show "catch_env (return_env x) m = return_env x" for x and m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff catch_return)
     show "catch_env fail_env m = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff catch_fail)
     show "catch_env m fail_env = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff catch_fail2)
     show "catch_env (catch_env m m') m'' = catch_env m (catch_env m' m'')"
       for m m' m'' :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff catch_assoc)
   qed
 qed
        
 end
 
 end
 
 subsubsection \<open>State\<close>
 
 context
   fixes get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
 begin
 
 definition get_env :: "('s, ('r, 'm) envT) get"
 where "get_env f = EnvT (\<lambda>r. get (\<lambda>s. run_env (f s) r))"
 
 definition put_env :: "('s, ('r, 'm) envT) put"
 where "put_env s m = EnvT (\<lambda>r. put s (run_env m r))"
 
 lemma run_get_env [simp]: "run_env (get_env f) r = get (\<lambda>s. run_env (f s) r)"
 by(simp add: get_env_def)
 
 lemma run_put_env [simp]: "run_env (put_env s m) r = put s (run_env m r)"
 by(simp add: put_env_def)
 
 lemma monad_state_envT [locale_witness]:
   assumes "monad_state return bind get put"
   shows "monad_state return_env bind_env get_env put_env"
 proof -
   interpret monad_state return bind get put by(fact assms)
   show ?thesis
   proof
     show "put_env s (get_env f) = put_env s (f s)" for s :: 's and f :: "'s \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff put_get)
     show "get_env (\<lambda>s. get_env (f s)) = get_env (\<lambda>s. f s s)" for f :: "'s \<Rightarrow> 's \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff get_get)
     show "put_env s (put_env s' m) = put_env s' m" for s s' :: 's and m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff put_put)
     show "get_env (\<lambda>s. put_env s m) = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff get_put)
     show "get_env (\<lambda>_. m) = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff get_const)
     show "bind_env (get_env f) g = get_env (\<lambda>s. bind_env (f s) g)" for f :: "'s \<Rightarrow> ('r, 'm) envT" and g
       by(rule envT.expand)(simp add: fun_eq_iff bind_get)
     show "bind_env (put_env s m) f = put_env s (bind_env m f)" for s and m :: "('r, 'm) envT" and f
       by(rule envT.expand)(simp add: fun_eq_iff bind_put)    
   qed
 qed
 
 subsubsection \<open>Probability\<close>
 
 context
   fixes sample :: "('p, 'm) sample"
 begin
 
 definition sample_env :: "('p, ('r, 'm) envT) sample"
 where "sample_env p f = EnvT (\<lambda>r. sample p (\<lambda>x. run_env (f x) r))"
 
 lemma run_sample_env [simp]: "run_env (sample_env p f) r = sample p (\<lambda>x. run_env (f x) r)"
 by(simp add: sample_env_def)
 
 lemma monad_prob_envT [locale_witness]:
   assumes "monad_prob return bind sample"
   shows "monad_prob return_env bind_env sample_env"
 proof -
   interpret monad_prob return bind sample by(fact assms)
   note sample_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "sample_env p (\<lambda>_. x) = x" for p :: "'p pmf" and x :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff sample_const)
     show "sample_env (return_pmf x) f = f x" for f :: "'p \<Rightarrow> ('r, 'm) envT" and x
       by(rule envT.expand)(simp add: fun_eq_iff sample_return_pmf)
     show "sample_env (bind_pmf p f) g = sample_env p (\<lambda>x. sample_env (f x) g)" for f and g :: "'p \<Rightarrow> ('r, 'm) envT" and p
       by(rule envT.expand)(simp add: fun_eq_iff sample_bind_pmf)
     show "sample_env p (\<lambda>x. sample_env q (f x)) = sample_env q (\<lambda>y. sample_env p (\<lambda>x. f x y))"
       for p q :: "'p pmf" and f :: "'p \<Rightarrow> 'p \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(auto simp add: fun_eq_iff intro: sample_commute)
     show "bind_env (sample_env p f) g = sample_env p (\<lambda>x. bind_env (f x) g)"
       for p and f :: "'p \<Rightarrow> ('r, 'm) envT" and g
       by(rule envT.expand)(simp add: fun_eq_iff bind_sample1)
     show "bind_env m (\<lambda>y. sample_env p (f y)) = sample_env p (\<lambda>x. bind_env m (\<lambda>y. f y x))"
       for m p and f :: "'a \<Rightarrow> 'p \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff bind_sample2)
     show "(rel_pmf R ===> (R ===> (=)) ===> (=)) sample_env sample_env"
       if [transfer_rule]: "bi_unique R" for R unfolding sample_env_def by transfer_prover
   qed
 qed
 
 lemma monad_state_prob_envT [locale_witness]:
   assumes "monad_state_prob return bind get put sample"
   shows "monad_state_prob return_env bind_env get_env put_env sample_env"
 proof -
   interpret monad_state_prob return bind get put sample by fact
   show ?thesis
   proof
     show "sample_env p (\<lambda>x. get_env (f x)) = get_env (\<lambda>s. sample_env p (\<lambda>x. f x s))"
       for p and f :: "'p \<Rightarrow> 's \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff sample_get)
   qed
 qed
 
 end
 
 subsubsection \<open>Binary Non-determinism\<close>
 
 context
   fixes alt :: "'m alt"
 begin
 
 definition alt_env :: "('r, 'm) envT alt"
 where "alt_env m1 m2 = EnvT (\<lambda>r. alt (run_env m1 r) (run_env m2 r))"
 
 lemma run_alt_env [simp]: "run_env (alt_env m1 m2) r = alt (run_env m1 r) (run_env m2 r)"
 by(simp add: alt_env_def)
 
 lemma monad_alt_envT [locale_witness]:
   assumes "monad_alt return bind alt"
   shows "monad_alt return_env bind_env alt_env"
 proof -
   interpret monad_alt return bind alt by fact
   show ?thesis
   proof
     show "alt_env (alt_env m1 m2) m3 = alt_env m1 (alt_env m2 m3)" for m1 m2 m3 :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff alt_assoc)
     show "bind_env (alt_env m m') f = alt_env (bind_env m f) (bind_env m' f)" for m m' :: "('r, 'm) envT" and f
       by(rule envT.expand)(simp add: fun_eq_iff bind_alt1)
   qed
 qed
 
 lemma monad_fail_alt_envT [locale_witness]:
   fixes fail
   assumes "monad_fail_alt return bind fail alt"
   shows "monad_fail_alt return_env bind_env (fail_env fail) alt_env"
 proof -
   interpret monad_fail_alt return bind fail alt by fact
   show ?thesis
   proof
     show "alt_env (fail_env fail) m = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: alt_fail1 fun_eq_iff)
     show "alt_env m (fail_env fail) = m" for m :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: alt_fail2 fun_eq_iff)
   qed
 qed
 
 lemma monad_state_alt_envT [locale_witness]:
   assumes "monad_state_alt return bind get put alt"
   shows "monad_state_alt return_env bind_env get_env put_env alt_env"
 proof -
   interpret monad_state_alt return bind get put alt by fact
   show ?thesis
   proof
     show "alt_env (get_env f) (get_env g) = get_env (\<lambda>x. alt_env (f x) (g x))"
       for f g :: "'s \<Rightarrow> ('b, 'm) envT" by(rule envT.expand)(simp add: fun_eq_iff alt_get)
     show "alt_env (put_env s m) (put_env s m') = put_env s (alt_env m m')"
       for s and m m' :: "('b, 'm) envT" by(rule envT.expand)(simp add: fun_eq_iff alt_put)
   qed
 qed
 
 end
 
 subsubsection \<open>Countable Non-determinism\<close>
 
 context
   fixes altc :: "('c, 'm) altc"
 begin
 
 definition altc_env :: "('c, ('r, 'm) envT) altc"
 where "altc_env C f = EnvT (\<lambda>r. altc C (\<lambda>c. run_env (f c) r))"
 
 lemma run_altc_env [simp]: "run_env (altc_env C f) r = altc C (\<lambda>c. run_env (f c) r)"
 by(simp add: altc_env_def)
 
 lemma monad_altc_envT [locale_witness]:
   assumes "monad_altc return bind altc"
   shows "monad_altc return_env bind_env altc_env"
 proof -
   interpret monad_altc return bind altc by fact
   note altc_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "bind_env (altc_env C g) f = altc_env C (\<lambda>c. bind_env (g c) f)" for C g and f :: "'a \<Rightarrow> ('b, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff bind_altc1)
     show "altc_env (csingle x) f = f x" for x and f :: "'c \<Rightarrow> ('b, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff altc_single)
     show "altc_env (cUNION C f) g = altc_env C (\<lambda>x. altc_env (f x) g)" for C f and g :: "'c \<Rightarrow> ('b, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff altc_cUNION)
     show "(rel_cset R ===> (R ===> (=)) ===> (=)) altc_env altc_env" if [transfer_rule]: "bi_unique R" for R
       unfolding altc_env_def by transfer_prover
   qed
 qed
 
 lemma monad_altc3_envT [locale_witness]:
   assumes "monad_altc3 return bind altc"
   shows "monad_altc3 return_env bind_env altc_env"
 proof -
   interpret monad_altc3 return bind altc by fact
   show ?thesis ..
 qed
 
 lemma monad_state_altc_envT [locale_witness]:
   assumes "monad_state_altc return bind get put altc"
   shows "monad_state_altc return_env bind_env get_env put_env altc_env"
 proof -
   interpret monad_state_altc return bind get put altc by fact
   show ?thesis
   proof
     show "altc_env C (\<lambda>c. get_env (f c)) = get_env (\<lambda>s. altc_env C (\<lambda>c. f c s))"
       for C and f :: "'c \<Rightarrow> 's \<Rightarrow> ('b, 'm) envT" by(rule envT.expand)(simp add: fun_eq_iff altc_get)
     show "altc_env C (\<lambda>c. put_env s (f c)) = put_env s (altc_env C f)"
       for C s and f :: "'c \<Rightarrow> ('b, 'm) envT" by(rule envT.expand)(simp add: fun_eq_iff altc_put)
   qed
 qed
 
 end
 
 end
 
 subsubsection \<open>Resumption\<close>
 
 context
   fixes pause :: "('o, 'i, 'm) pause"
 begin
 
 definition pause_env :: "('o, 'i, ('r, 'm) envT) pause"
 where "pause_env out c = EnvT (\<lambda>r. pause out (\<lambda>i. run_env (c i) r))"
 
 lemma run_pause_env [simp]:
   "run_env (pause_env out c) r = pause out (\<lambda>i. run_env (c i) r)"
 by(simp add: pause_env_def)
 
 lemma monad_resumption_envT [locale_witness]:
   assumes "monad_resumption return bind pause"
   shows "monad_resumption return_env bind_env pause_env"
 proof -
   interpret monad_resumption return bind pause by fact
   show ?thesis
   proof
     show "bind_env (pause_env out c) f = pause_env out (\<lambda>i. bind_env (c i) f)" for out f and c :: "'i \<Rightarrow> ('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff bind_pause)
   qed
 qed
 
 end
 
 subsubsection \<open>Writer\<close>
 
 context
   fixes tell :: "('w, 'm) tell"
 begin
 
 definition tell_env :: "('w, ('r, 'm) envT) tell"
 where "tell_env w m = EnvT (\<lambda>r. tell w (run_env m r))"
 
 lemma run_tell_env [simp]: "run_env (tell_env w m) r = tell w (run_env m r)"
 by(simp add: tell_env_def)
 
 lemma monad_writer_envT [locale_witness]:
   assumes "monad_writer return bind tell"
   shows "monad_writer return_env bind_env tell_env"
 proof -
   interpret monad_writer return bind tell by fact
   show ?thesis
   proof
     show "bind_env (tell_env w m) f = tell_env w (bind_env m f)" for w and m :: "('r, 'm) envT" and f
       by(rule envT.expand)(simp add: bind_tell fun_eq_iff)
   qed
 qed
 
 end
 
 subsubsection \<open>Commutativity\<close>
 
 lemma monad_commute_envT [locale_witness]:
   assumes "monad_commute return bind"
   shows "monad_commute return_env bind_env"
 proof -
   interpret monad_commute return bind by fact
   show ?thesis
   proof
     show "bind_env m (\<lambda>x. bind_env m' (f x)) = bind_env m' (\<lambda>y. bind_env m (\<lambda>x. f x y))"
       for f and m m' :: "('r, 'm) envT"
       by(rule envT.expand)(auto simp add: fun_eq_iff intro: bind_commute)
   qed
 qed
 
 subsubsection \<open>Discardability\<close>
 
 lemma monad_discard_envT [locale_witness]:
   assumes "monad_discard return bind"
   shows "monad_discard return_env bind_env"
 proof -
   interpret monad_discard return bind by fact
   show ?thesis
   proof
     show "bind_env m (\<lambda>_. m') = m'" for m m' :: "('r, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff bind_const)
   qed
 qed
 
 subsubsection \<open>Duplicability\<close>
 
 lemma monad_duplicate_envT [locale_witness]:
   assumes "monad_duplicate return bind"
   shows "monad_duplicate return_env bind_env"
 proof -
   interpret monad_duplicate return bind by fact
   show ?thesis
   proof
     show "bind_env m (\<lambda>x. bind_env m (f x)) = bind_env m (\<lambda>x. f x x)" for m :: "('b, 'm) envT" and f
       by(rule envT.expand)(simp add: fun_eq_iff bind_duplicate)
   qed
 qed
 
 end
 
 subsubsection \<open>Parametricity\<close>
 
 context includes lifting_syntax begin
 
 lemma return_env_parametric [transfer_rule]:
   "((A ===> M) ===> A ===> rel_envT R M) return_env return_env"
 unfolding return_env_def by transfer_prover
 
 lemma bind_env_parametric [transfer_rule]:
   "((M ===> (A ===> M) ===> M) ===> rel_envT R M ===> (A ===> rel_envT R M) ===> rel_envT R M)
    bind_env bind_env"
 unfolding bind_env_def by transfer_prover
 
 lemma ask_env_parametric [transfer_rule]: "((R ===> rel_envT R M) ===> rel_envT R M) ask_env ask_env"
 unfolding ask_env_def by transfer_prover
 
 lemma fail_env_parametric [transfer_rule]: "(M ===> rel_envT R M) fail_env fail_env"
 unfolding fail_env_def by transfer_prover
 
 lemma catch_env_parametric [transfer_rule]: 
   "((M ===> M ===> M) ===> rel_envT R M ===> rel_envT R M ===> rel_envT R M) catch_env catch_env"
 unfolding catch_env_def by transfer_prover
 
 lemma get_env_parametric [transfer_rule]:
   "(((S ===> M) ===> M) ===> (S ===> rel_envT R M) ===> rel_envT R M) get_env get_env"
 unfolding get_env_def by transfer_prover
 
 lemma put_env_parametric [transfer_rule]:
   "((S ===> M ===> M) ===> S ===> rel_envT R M ===> rel_envT R M) put_env put_env"
 unfolding put_env_def by transfer_prover
 
 lemma sample_env_parametric [transfer_rule]:
   "((rel_pmf P ===> (P ===> M) ===> M) ===> rel_pmf P ===> (P ===> rel_envT R M) ===> rel_envT R M)
   sample_env sample_env"
 unfolding sample_env_def by transfer_prover
 
 lemma alt_env_parametric [transfer_rule]:
   "((M ===> M ===> M) ===> rel_envT R M ===> rel_envT R M ===> rel_envT R M) alt_env alt_env"
 unfolding alt_env_def by transfer_prover
 
 lemma altc_env_parametric [transfer_rule]:
   "((rel_cset C ===> (C ===> M) ===> M) ===> rel_cset C ===> (C ===> rel_envT R M) ===> rel_envT R M) 
    altc_env altc_env"
 unfolding altc_env_def by transfer_prover
 
 lemma pause_env_parametric [transfer_rule]:
   "((Out ===> (In ===> M) ===> M) ===> Out ===> (In ===> rel_envT R M) ===> rel_envT R M)
    pause_env pause_env"
 unfolding pause_env_def by transfer_prover
 
 lemma tell_env_parametric [transfer_rule]:
   "((W ===> M ===> M) ===> W ===> rel_envT R M ===> rel_envT R M) tell_env tell_env"
 unfolding tell_env_def by transfer_prover
 
 end
 
 subsection \<open>Unbounded non-determinism\<close>
 
 abbreviation (input) return_set :: "('a, 'a set) return" where "return_set x \<equiv> {x}"
 abbreviation (input) bind_set :: "('a, 'a set) bind" where "bind_set \<equiv> \<lambda>A f. \<Union> (f ` A)"
 abbreviation (input) fail_set :: "'a set fail" where "fail_set \<equiv> {}"
 abbreviation (input) alt_set :: "'a set alt" where "alt_set \<equiv> (\<union>)"
 abbreviation (input) altc_set :: "('c, 'a set) altc" where "altc_set C \<equiv> \<lambda>f. \<Union> (f ` rcset C)"
 
 lemma monad_set [locale_witness]: "monad return_set bind_set"
 by unfold_locales auto
 
 lemma monad_fail_set [locale_witness]: "monad_fail return_set bind_set fail_set"
 by unfold_locales auto
 
 lemma monad_lift_set [simp]: "monad_base.lift return_set bind_set  = image"
 by(auto simp add: monad_base.lift_def o_def fun_eq_iff)
 
 lemma monad_alt_set [locale_witness]: "monad_alt return_set bind_set alt_set"
 by unfold_locales auto
 
 lemma monad_altc_set [locale_witness]: "monad_altc return_set bind_set altc_set"
   including cset.lifting lifting_syntax
 proof
   show "(rel_cset R ===> (R ===> (=)) ===> (=)) (\<lambda>C f. \<Union> (f ` rcset C)) (\<lambda>C f. \<Union> (f ` rcset C))" for R
     by transfer_prover
 qed(transfer; auto; fail)+
 
 lemma monad_altc3_set [locale_witness]:
   "monad_altc3 return_set bind_set (altc_set :: ('c, 'a set) altc)"
   if [locale_witness]: "three TYPE('c)"
   ..
 
 subsection \<open>Non-determinism transformer\<close>
 
 datatype (plugins del: transfer) (phantom_nondetT: 'a, set_nondetT: 'm) nondetT = NondetT (run_nondet: 'm)
   for map: map_nondetT'
       rel: rel_nondetT'
 
 text \<open>
   We define our own relator and mapper such that the phantom variable does not need any relation.
 \<close>
 
 lemma phantom_nondetT [simp]: "phantom_nondetT x = {}"
 by(cases x) simp
 
 context includes lifting_syntax begin
 
 lemma rel_nondetT'_phantom: "rel_nondetT' A = rel_nondetT' top"
 by(auto 4 4 intro: nondetT.rel_mono antisym nondetT.rel_mono_strong)
 
 lemma map_nondetT'_phantom: "map_nondetT' f = map_nondetT' undefined"
 by(auto 4 4 intro: nondetT.map_cong)
 
 definition map_nondetT :: "('m \<Rightarrow> 'm') \<Rightarrow> ('a, 'm) nondetT \<Rightarrow> ('b, 'm') nondetT"
 where "map_nondetT = map_nondetT' undefined"
 
 definition rel_nondetT :: "('m \<Rightarrow> 'm' \<Rightarrow> bool) \<Rightarrow> ('a, 'm) nondetT \<Rightarrow> ('b, 'm') nondetT \<Rightarrow> bool"
 where "rel_nondetT = rel_nondetT' top"
 
 lemma rel_nondetTE:
   assumes "rel_nondetT M m m'"
   obtains x y where "m = NondetT x" "m' = NondetT y" "M x y"
 using assms by(cases m; cases m'; simp add: rel_nondetT_def)
 
 lemma rel_nondetT_simps [simp]: "rel_nondetT M (NondetT m) (NondetT m') \<longleftrightarrow> M m m'"
 by(simp add: rel_nondetT_def)
 
 lemma rel_nondetT_unfold: 
   "\<And>m m'. rel_nondetT M (NondetT m) m' \<longleftrightarrow> (\<exists>m''. m' = NondetT m'' \<and> M m m'')"
   "\<And>m m'. rel_nondetT M m (NondetT m') \<longleftrightarrow> (\<exists>m''. m = NondetT m'' \<and> M m'' m')"
   subgoal for m m' by(cases m'; simp)
   subgoal for m m' by(cases m; simp)
   done
 
 lemma rel_nondetT_expand: "M (run_nondet m) (run_nondet m') \<Longrightarrow> rel_nondetT M m m'"
   by(cases m; cases m'; simp)
 
 lemma rel_nondetT_eq [relator_eq]: "rel_nondetT (=) = (=)"
 by(auto simp add: fun_eq_iff rel_nondetT_def intro: nondetT.rel_refl_strong elim: nondetT.rel_cases)
 
 lemma rel_nondetT_mono [relator_mono]: "rel_nondetT A \<le> rel_nondetT B" if "A \<le> B"
 by(simp add: rel_nondetT_def nondetT.rel_mono that)
 
 lemma rel_nondetT_distr [relator_distr]: "rel_nondetT A OO rel_nondetT B = rel_nondetT (A OO B)"
 by(simp add: rel_nondetT_def nondetT.rel_compp[symmetric])
 
 lemma rel_nondetT_Grp: "rel_nondetT (BNF_Def.Grp A f) = BNF_Def.Grp {x. set_nondetT x \<subseteq> A} (map_nondetT f)"
 by(simp add: rel_nondetT_def rel_nondetT'_phantom[of "BNF_Def.Grp UNIV undefined", symmetric] nondetT.rel_Grp map_nondetT_def)
 
 lemma NondetT_parametric [transfer_rule]: "(M ===> rel_nondetT M) NondetT NondetT"
 by(simp add: rel_fun_def rel_nondetT_def)
 
 lemma run_nondet_parametric [transfer_rule]: "(rel_nondetT M ===> M) run_nondet run_nondet"
 by(auto simp add: rel_fun_def rel_nondetT_def elim: nondetT.rel_cases)
 
 lemma case_nondetT_parametric [transfer_rule]:
   "((M ===> X) ===> rel_nondetT M ===> X) case_nondetT case_nondetT"
 by(auto simp add: rel_fun_def rel_nondetT_def split: nondetT.split)
 
 lemma rec_nondetT_parametric [transfer_rule]:
   "((M ===> X) ===> rel_nondetT M ===> X) rec_nondetT rec_nondetT"
 by(auto simp add: rel_fun_def elim: rel_nondetTE)
 
 end
 
 subsubsection \<open>Generic implementation\<close>
 
 type_synonym ('a, 'm, 's) merge = "'s \<Rightarrow> ('a \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 locale nondetM_base = monad_base return bind
   for return :: "('s, 'm) return"
   and bind :: "('s, 'm) bind"
   and merge :: "('a, 'm, 's) merge"
   and empty :: "'s"
   and single :: "'a \<Rightarrow> 's"
   and union :: "'s \<Rightarrow> 's \<Rightarrow> 's"  (infixl "\<^bold>\<union>" 65)
 begin
 
 definition return_nondet :: "('a, ('a, 'm) nondetT) return"
 where "return_nondet x = NondetT (return (single x))"
 
 definition bind_nondet :: "('a, ('a, 'm) nondetT) bind"
 where "bind_nondet m f = NondetT (bind (run_nondet m) (\<lambda>A. merge A (run_nondet \<circ> f)))"
 
 definition fail_nondet :: "('a, 'm) nondetT fail"
 where "fail_nondet = NondetT (return empty)"
 
 definition alt_nondet :: "('a, 'm) nondetT alt"
 where "alt_nondet m1 m2 = NondetT (bind (run_nondet m1) (\<lambda>A. bind (run_nondet m2) (\<lambda>B. return (A \<^bold>\<union> B))))"
 
 definition get_nondet :: "('state, 'm) get \<Rightarrow> ('state, ('a, 'm) nondetT) get"
 where "get_nondet get f = NondetT (get (\<lambda>s. run_nondet (f s)))" for get
 
 definition put_nondet :: "('state, 'm) put \<Rightarrow> ('state, ('a, 'm) nondetT) put"
 where "put_nondet put s m = NondetT (put s (run_nondet m))" for put
 
 definition ask_nondet :: "('r, 'm) ask \<Rightarrow> ('r, ('a, 'm) nondetT) ask"
 where "ask_nondet ask f = NondetT (ask (\<lambda>r. run_nondet (f r)))"
 
 text \<open>
   The canonical lift of sampling into @{typ "(_, _) nondetT"} does not satisfy @{const monad_prob},
   because sampling does not distribute over bind backwards. Intuitively, if we sample first,
   then the same sample is used in all non-deterministic choices. But if we sample later,
   each non-deterministic choice may sample a different value.
 \<close>
 
 lemma run_return_nondet [simp]: "run_nondet (return_nondet x) = return (single x)"
 by(simp add: return_nondet_def)
 
 lemma run_bind_nondet [simp]:
   "run_nondet (bind_nondet m f) = bind (run_nondet m) (\<lambda>A. merge A (run_nondet \<circ> f))"
 by(simp add: bind_nondet_def)
 
 lemma run_fail_nondet [simp]: "run_nondet fail_nondet = return empty"
 by(simp add: fail_nondet_def)
 
 lemma run_alt_nondet [simp]:
   "run_nondet (alt_nondet m1 m2) = bind (run_nondet m1) (\<lambda>A. bind (run_nondet m2) (\<lambda>B. return (A \<^bold>\<union> B)))"
 by(simp add: alt_nondet_def)
 
 lemma run_get_nondet [simp]: "run_nondet (get_nondet get f) = get (\<lambda>s. run_nondet (f s))" for get
 by(simp add: get_nondet_def)
 
 lemma run_put_nondet [simp]: "run_nondet (put_nondet put s m) = put s (run_nondet m)" for put
 by(simp add: put_nondet_def)
 
 lemma run_ask_nondet [simp]: "run_nondet (ask_nondet ask f) = ask (\<lambda>r. run_nondet (f r))" for ask
 by(simp add: ask_nondet_def)
 
 end
 
 lemma bind_nondet_cong [cong]:
   "nondetM_base.bind_nondet bind merge = nondetM_base.bind_nondet bind merge" for bind merge ..
 
 lemmas [code] = 
   nondetM_base.return_nondet_def
   nondetM_base.bind_nondet_def
   nondetM_base.fail_nondet_def
   nondetM_base.alt_nondet_def
   nondetM_base.get_nondet_def
   nondetM_base.put_nondet_def
   nondetM_base.ask_nondet_def
 
 locale nondetM = nondetM_base return bind merge empty single union
   +
   monad_commute return bind
   for return :: "('s, 'm) return"
   and bind :: "('s, 'm) bind"
   and merge :: "('a, 'm, 's) merge"
   and empty :: "'s"
   and single :: "'a \<Rightarrow> 's"
   and union :: "'s \<Rightarrow> 's \<Rightarrow> 's" (infixl "\<^bold>\<union>" 65)
   +
   assumes bind_merge_merge:
     "\<And>y f g. bind (merge y f) (\<lambda>A. merge A g) = merge y (\<lambda>x. bind (f x) (\<lambda>A. merge A g))"
   and merge_empty: "\<And>f. merge empty f = return empty"
   and merge_single: "\<And>x f. merge (single x) f = f x"
   and merge_single2: "\<And>A. merge A (\<lambda>x. return (single x)) = return A"
   and merge_union: "\<And>A B f. merge (A \<^bold>\<union> B) f = bind (merge A f) (\<lambda>A'. bind (merge B f) (\<lambda>B'. return (A' \<^bold>\<union> B')))"
   and union_assoc: "\<And>A B C. (A \<^bold>\<union> B) \<^bold>\<union> C = A \<^bold>\<union> (B \<^bold>\<union> C)"
   and empty_union: "\<And>A. empty \<^bold>\<union> A = A"
   and union_empty: "\<And>A. A \<^bold>\<union> empty = A"
 begin
 
 lemma monad_nondetT [locale_witness]: "monad return_nondet bind_nondet"
 proof
   show "bind_nondet (bind_nondet x f) g = bind_nondet x (\<lambda>y. bind_nondet (f y) g)" for x f g
     by(rule nondetT.expand)(simp add: bind_assoc bind_merge_merge o_def)
   show "bind_nondet (return_nondet x) f = f x" for x f
     by(rule nondetT.expand)(simp add: return_bind merge_single)
   show "bind_nondet x return_nondet = x" for x
     by(rule nondetT.expand)(simp add: bind_return o_def merge_single2)
 qed
 
 lemma monad_fail_nondetT [locale_witness]: "monad_fail return_nondet bind_nondet fail_nondet"
 proof
   show "bind_nondet fail_nondet f = fail_nondet" for f
     by(rule nondetT.expand)(simp add: return_bind merge_empty)
 qed
 
 lemma monad_alt_nondetT [locale_witness]: "monad_alt return_nondet bind_nondet alt_nondet"
 proof
   show "alt_nondet (alt_nondet m1 m2) m3 = alt_nondet m1 (alt_nondet m2 m3)" for m1 m2 m3
     by(rule nondetT.expand)(simp add: bind_assoc return_bind union_assoc)
   show "bind_nondet (alt_nondet m m') f = alt_nondet (bind_nondet m f) (bind_nondet m' f)" for m m' f
     apply(rule nondetT.expand)
     apply(simp add: bind_assoc return_bind)
     apply(subst (2) bind_commute)
     apply(simp add: merge_union)
     done
 qed
 
 lemma monad_fail_alt_nondetT [locale_witness]:
   "monad_fail_alt return_nondet bind_nondet fail_nondet alt_nondet"
 proof
   show "alt_nondet fail_nondet m = m" for  m
     by(rule nondetT.expand)(simp add: return_bind bind_return empty_union)
   show "alt_nondet m fail_nondet = m" for m
     by(rule nondetT.expand)(simp add: return_bind bind_return union_empty)
 qed
 
 lemma monad_state_nondetT [locale_witness]:
   \<comment> \<open>It's not really sensible to assume a commutative state monad, but let's prove it anyway ...\<close>
   fixes get put
   assumes "monad_state return bind get put"
   shows "monad_state return_nondet bind_nondet (get_nondet get) (put_nondet put)"
 proof -
   interpret monad_state return bind get put by fact
   show ?thesis
   proof
     show "put_nondet put s (get_nondet get f) = put_nondet put s (f s)" for s f
       by(rule nondetT.expand)(simp add: put_get)
     show "get_nondet get (\<lambda>s. get_nondet get (f s)) = get_nondet get (\<lambda>s. f s s)" for f
       by(rule nondetT.expand)(simp add: get_get)
     show "put_nondet put s (put_nondet put s' m) = put_nondet put s' m" for s s' m
       by(rule nondetT.expand)(simp add: put_put)
     show "get_nondet get (\<lambda>s. put_nondet put s m) = m" for m
       by(rule nondetT.expand)(simp add: get_put)
     show "get_nondet get (\<lambda>_. m) = m" for m
       by(rule nondetT.expand)(simp add: get_const)
     show "bind_nondet (get_nondet get f) g = get_nondet get (\<lambda>s. bind_nondet (f s) g)" for f g
       by(rule nondetT.expand)(simp add: bind_get)
     show "bind_nondet (put_nondet put s m) f = put_nondet put s (bind_nondet m f)" for s m f
       by(rule nondetT.expand)(simp add: bind_put)
   qed
 qed
 
 lemma monad_state_alt_nondetT [locale_witness]:
   fixes get put
   assumes "monad_state return bind get put"
   shows "monad_state_alt return_nondet bind_nondet (get_nondet get) (put_nondet put) alt_nondet"
 proof -
   interpret monad_state return bind get put by fact
   show ?thesis
   proof
     show "alt_nondet (get_nondet get f) (get_nondet get g) = get_nondet get (\<lambda>x. alt_nondet (f x) (g x))"
       for f g
       apply(rule nondetT.expand; simp)
       apply(subst bind_get)
       apply(subst (1 2) bind_commute)
       apply(simp add: bind_get get_get)
       done
     show "alt_nondet (put_nondet put s m) (put_nondet put s m') = put_nondet put s (alt_nondet m m')"
       for s m m'
       apply(rule nondetT.expand; simp)
       apply(subst bind_put)
       apply(subst (1 2) bind_commute)
       apply(simp add: bind_put put_put)
       done
   qed
 qed
 
 end
 
 lemmas nondetM_lemmas =
   nondetM.monad_nondetT
   nondetM.monad_fail_nondetT
   nondetM.monad_alt_nondetT
   nondetM.monad_fail_alt_nondetT
   nondetM.monad_state_nondetT
 
 locale nondetM_ask = nondetM return bind merge empty single union
   for return :: "('s, 'm) return"
   and bind :: "('s, 'm) bind"
   and ask :: "('r, 'm) ask"
   and merge :: "('a, 'm, 's) merge"
   and empty :: "'s"
   and single :: "'a \<Rightarrow> 's"
   and union :: "'s \<Rightarrow> 's \<Rightarrow> 's" (infixl "\<^bold>\<union>" 65)
   +
   assumes monad_reader: "monad_reader return bind ask"
   assumes merge_ask:
     "\<And>A (f :: 'a \<Rightarrow> 'r \<Rightarrow> ('a, 'm) nondetT). merge A (\<lambda>x. ask (\<lambda>r. run_nondet (f x r))) =
      ask (\<lambda>r. merge A (\<lambda>x. run_nondet (f x r)))"
 begin
 
 interpretation monad_reader return bind ask by(fact monad_reader)
 
 lemma monad_reader_nondetT: "monad_reader return_nondet bind_nondet (ask_nondet ask)"
 proof
   show "ask_nondet ask (\<lambda>r. ask_nondet ask (f r)) = ask_nondet ask (\<lambda>r. f r r)" for f
     by(rule nondetT.expand)(simp add: ask_ask)
   show "ask_nondet ask (\<lambda>_. m) = m" for m
     by(rule nondetT.expand)(simp add: ask_const)
   show "bind_nondet (ask_nondet ask f) g = ask_nondet ask (\<lambda>r. bind_nondet (f r) g)" for f g
     by(rule nondetT.expand)(simp add: bind_ask)
   show "bind_nondet m (\<lambda>x. ask_nondet ask (f x)) = ask_nondet ask (\<lambda>r. bind_nondet m (\<lambda>x. f x r))" for f m
     by(rule nondetT.expand)(simp add: bind_ask2[symmetric] o_def merge_ask)
 qed
 
 end
 
 lemmas nondetM_ask_lemmas =
   nondetM_ask.monad_reader_nondetT
 
 subsubsection \<open>Parametricity\<close>
 
 context includes lifting_syntax begin
 
 lemma return_nondet_parametric [transfer_rule]:
   "((S ===> M) ===> (A ===> S) ===> A ===> rel_nondetT M)
    nondetM_base.return_nondet nondetM_base.return_nondet"
   unfolding nondetM_base.return_nondet_def by transfer_prover
 
 lemma bind_nondet_parametric [transfer_rule]:
   "((M ===> (S ===> M) ===> M) ===> (S ===> (A ===> M) ===> M) ===> 
     rel_nondetT M ===> (A ===> rel_nondetT M) ===> rel_nondetT M)
    nondetM_base.bind_nondet nondetM_base.bind_nondet"
   unfolding nondetM_base.bind_nondet_def by transfer_prover
 
 lemma fail_nondet_parametric [transfer_rule]:
   "((S ===> M) ===> S ===> rel_nondetT M) nondetM_base.fail_nondet nondetM_base.fail_nondet"
   unfolding nondetM_base.fail_nondet_def by transfer_prover
 
 lemma alt_nondet_parametric [transfer_rule]:
   "((S ===> M) ===> (M ===> (S ===> M) ===> M) ===> (S ===> S ===> S) ===>
     rel_nondetT M ===> rel_nondetT M ===> rel_nondetT M)
    nondetM_base.alt_nondet nondetM_base.alt_nondet"
   unfolding nondetM_base.alt_nondet_def by transfer_prover
 
 lemma get_nondet_parametric [transfer_rule]:
   "(((S ===> M) ===> M) ===> (S ===> rel_nondetT M) ===> rel_nondetT M)
    nondetM_base.get_nondet nondetM_base.get_nondet"
   unfolding nondetM_base.get_nondet_def by transfer_prover
 
 lemma put_nondet_parametric [transfer_rule]:
   "((S ===> M ===> M) ===> S ===> rel_nondetT M ===> rel_nondetT M) 
    nondetM_base.put_nondet nondetM_base.put_nondet"
   unfolding nondetM_base.put_nondet_def by transfer_prover
 
 lemma ask_nondet_parametric [transfer_rule]:
   "(((R ===> M) ===> M) ===> (R ===> rel_nondetT M) ===> rel_nondetT M)
    nondetM_base.ask_nondet nondetM_base.ask_nondet"
   unfolding nondetM_base.ask_nondet_def by transfer_prover
 
 end
 
 subsubsection \<open>Implementation using lists\<close>
 
 context 
   fixes return :: "('a list, 'm) return"
     and bind :: "('a list, 'm) bind"
     and lunionM lUnionM 
   defines "lunionM m1 m2 \<equiv> bind m1 (\<lambda>A. bind m2 (\<lambda>B. return (A @ B)))"
     and "lUnionM ms \<equiv> foldr lunionM ms (return [])"
 begin
 
 definition lmerge :: "'a list \<Rightarrow> ('a \<Rightarrow> 'm) \<Rightarrow> 'm" where
   "lmerge A f = lUnionM (map f A)"
 
 context
   assumes "monad_commute return bind"
 begin
 
 interpretation monad_commute return bind by fact
 interpretation nondetM_base return bind lmerge "[]" "\<lambda>x. [x]" "(@)" .
 
 lemma lUnionM_empty [simp]: "lUnionM [] = return []" by(simp add: lUnionM_def)
 lemma lUnionM_Cons [simp]: "lUnionM (x # M) = lunionM x (lUnionM M)" for x M
   by(simp add: lUnionM_def)
 lemma lunionM_return_empty1 [simp]: "lunionM (return []) x = x" for x
   by(simp add: lunionM_def return_bind bind_return)
 lemma lunionM_return_empty2 [simp]: "lunionM x (return []) = x" for x
   by(simp add: lunionM_def return_bind bind_return)
 lemma lunionM_return_return [simp]: "lunionM (return A) (return B) = return (A @ B)" for A B
   by(simp add: lunionM_def return_bind)
 lemma lunionM_assoc: "lunionM (lunionM x y) z = lunionM x (lunionM y z)" for x y z
   by(simp add: lunionM_def bind_assoc return_bind)
 lemma lunionM_lUnionM1: "lunionM (lUnionM A) x = foldr lunionM A x" for A x
   by(induction A arbitrary: x)(simp_all add: lunionM_assoc)
 lemma lUnionM_append [simp]: "lUnionM (A @ B) = lunionM (lUnionM A) (lUnionM B)" for A B
   by(subst lunionM_lUnionM1)(simp add: lUnionM_def)
 lemma lUnionM_return [simp]: "lUnionM (map (\<lambda>x. return [x]) A) = return A" for A
   by(induction A) simp_all
 lemma bind_lunionM: "bind (lunionM m m') f = lunionM (bind m f) (bind m' f)"
   if "\<And>A B. f (A @ B) = bind (f A) (\<lambda>x. bind (f B) (\<lambda>y. return (x @ y)))" for m m' f
   apply(simp add: bind_assoc return_bind lunionM_def that)
   apply(subst (2) bind_commute)
   apply simp
   done
 
 lemma list_nondetM: "nondetM return bind lmerge [] (\<lambda>x. [x]) (@)"
 proof
   show "bind (lmerge y f) (\<lambda>A. lmerge A g) = lmerge y (\<lambda>x. bind (f x) (\<lambda>A. lmerge A g))" for y f g
     apply(induction y)
     apply(simp_all add: lmerge_def return_bind)
     apply(subst bind_lunionM; simp add: lunionM_def o_def)
     done
   show "lmerge [] f = return []" for f by(simp add: lmerge_def)
   show "lmerge [x] f = f x" for x f by(simp add: lmerge_def)
   show "lmerge A (\<lambda>x. return [x]) = return A" for A by(simp add: lmerge_def)
   show "lmerge (A @ B) f = bind (lmerge A f) (\<lambda>A'. bind (lmerge B f) (\<lambda>B'. return (A' @ B')))"
     for f A B by(simp add: lmerge_def lunionM_def)
 qed simp_all
 
 lemma list_nondetM_ask:
   notes list_nondetM[locale_witness]
   assumes [locale_witness]: "monad_reader return bind ask"
   shows "nondetM_ask return bind ask lmerge [] (\<lambda>x. [x]) (@)"
 proof
   interpret monad_reader return bind ask by fact
   show "lmerge A (\<lambda>x. ask (\<lambda>r. run_nondet (f x r))) = ask (\<lambda>r. lmerge A (\<lambda>x. run_nondet (f x r)))"
     for A and f :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'm) nondetT" unfolding lmerge_def
     by(induction A)(simp_all add: ask_const lunionM_def bind_ask bind_ask2 ask_ask)
 qed
 
 lemmas list_nondetMs [locale_witness] =
   nondetM_lemmas[OF list_nondetM]
   nondetM_ask_lemmas[OF list_nondetM_ask]
 
 end
 
 end
 
 lemma lmerge_parametric [transfer_rule]: includes lifting_syntax shows
   "((list_all2 A ===> M) ===> (M ===> (list_all2 A ===> M) ===> M)
     ===> list_all2 A ===> (A ===> M) ===> M)
    lmerge lmerge"
   unfolding lmerge_def by transfer_prover
 
 subsubsection \<open>Implementation using multisets\<close>
 
 context 
   fixes return :: "('a multiset, 'm) return"
     and bind :: "('a multiset, 'm) bind"
     and munionM mUnionM
   defines "munionM m1 m2 \<equiv> bind m1 (\<lambda>A. bind m2 (\<lambda>B. return (A + B)))"
     and "mUnionM \<equiv> fold_mset munionM (return {#})"
 begin
 
 definition mmerge :: "'a multiset \<Rightarrow> ('a \<Rightarrow> 'm) \<Rightarrow> 'm"
 where "mmerge A f = mUnionM (image_mset f A)"
 
 context
   assumes "monad_commute return bind"
 begin
 
 interpretation monad_commute return bind by fact
 interpretation nondetM_base return bind mmerge "{#}" "\<lambda>x. {#x#}" "(+)" .
 
 lemma munionM_comp_fun_commute: "comp_fun_commute munionM"
   apply(unfold_locales)
   apply(simp add: fun_eq_iff bind_assoc return_bind munionM_def)
   apply(subst bind_commute)
   apply(simp add: union_ac)
   done
 
 interpretation comp_fun_commute munionM by(rule munionM_comp_fun_commute)
 
 lemma mUnionM_empty [simp]: "mUnionM {#} = return {#}" by(simp add: mUnionM_def)
 lemma mUnionM_add_mset [simp]: "mUnionM (add_mset x M) = munionM x (mUnionM M)" for x M
   by(simp add: mUnionM_def)
 lemma munionM_return_empty1 [simp]: "munionM (return {#}) x = x" for x
   by(simp add: munionM_def return_bind bind_return)
 lemma munionM_return_empty2 [simp]: "munionM x (return {#}) = x" for x
   by(simp add: munionM_def return_bind bind_return)
 lemma munionM_return_return [simp]: "munionM (return A) (return B) = return (A + B)" for A B
   by(simp add: munionM_def return_bind)
 lemma munionM_assoc: "munionM (munionM x y) z = munionM x (munionM y z)" for x y z
   by(simp add: munionM_def bind_assoc return_bind add.assoc)
 lemma munionM_commute: "munionM x y = munionM y x" for x y
   unfolding munionM_def by(subst bind_commute)(simp add: add.commute)
 lemma munionM_mUnionM1: "munionM (mUnionM A) x = fold_mset munionM x A" for A x
   by(induction A arbitrary: x)(simp_all add: munionM_assoc)
 lemma munionM_mUnionM2: "munionM x (mUnionM A) = fold_mset munionM x A" for x A
   by(subst munionM_commute)(rule munionM_mUnionM1)
 lemma mUnionM_add [simp]: "mUnionM (A + B) = munionM (mUnionM A) (mUnionM B)" for A B
   by(subst munionM_mUnionM2)(simp add: mUnionM_def)
 lemma mUnionM_return [simp]: "mUnionM (image_mset (\<lambda>x. return {#x#}) A) = return A" for A
   by(induction A) simp_all
 lemma bind_munionM: "bind (munionM m m') f = munionM (bind m f) (bind m' f)"
   if "\<And>A B. f (A + B) = bind (f A) (\<lambda>x. bind (f B) (\<lambda>y. return (x + y)))" for m m' f
   apply(simp add: bind_assoc return_bind munionM_def that)
   apply(subst (2) bind_commute)
   apply simp
   done
 
 lemma mset_nondetM: "nondetM return bind mmerge {#} (\<lambda>x. {#x#}) (+)"
 proof
   show "bind (mmerge y f) (\<lambda>A. mmerge A g) = mmerge y (\<lambda>x. bind (f x) (\<lambda>A. mmerge A g))" for y f g
     apply(induction y)
     apply(simp_all add: return_bind mmerge_def)
     apply(subst bind_munionM; simp add: munionM_def o_def)
     done
   show "mmerge {#} f = return {#}" for f by(simp add: mmerge_def)
   show "mmerge {#x#} f = f x" for x f by(simp add: mmerge_def)
   show "mmerge A (\<lambda>x. return {#x#}) = return A" for A by(simp add: mmerge_def)
   show "mmerge (A + B) f = bind (mmerge A f) (\<lambda>A'. bind (mmerge B f) (\<lambda>B'. return (A' + B')))"
     for f A B by(simp add: mmerge_def munionM_def)
 qed simp_all
 
 lemma mset_nondetM_ask:
   notes mset_nondetM[locale_witness]
   assumes [locale_witness]: "monad_reader return bind ask"
   shows "nondetM_ask return bind ask mmerge {#} (\<lambda>x. {#x#}) (+)"
 proof
   interpret monad_reader return bind ask by fact
   show "mmerge A (\<lambda>x. ask (\<lambda>r. run_nondet (f x r))) = ask (\<lambda>r. mmerge A (\<lambda>x. run_nondet (f x r)))"
     for A and f :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'm) nondetT" unfolding mmerge_def
     by(induction A)(simp_all add: ask_const munionM_def bind_ask bind_ask2 ask_ask)
 qed
 
 lemmas mset_nondetMs [locale_witness] =
   nondetM_lemmas[OF mset_nondetM]
   nondetM_ask_lemmas[OF mset_nondetM_ask]
 
 end
 
 end
 
 lemma mmerge_parametric:
   includes lifting_syntax
   assumes return [transfer_rule]: "(rel_mset A ===> M) return1 return2"
     and bind [transfer_rule]: "(M ===> (rel_mset A ===> M) ===> M) bind1 bind2"
     and comm1: "monad_commute return1 bind1"
     and comm2: "monad_commute return2 bind2"
   shows "(rel_mset A ===> (A ===> M) ===> M) (mmerge return1 bind1) (mmerge return2 bind2)"
   unfolding mmerge_def
   apply(rule rel_funI)+
   apply(drule (1) multiset.map_transfer[THEN rel_funD, THEN rel_funD])
   apply(rule fold_mset_parametric[OF _ munionM_comp_fun_commute[OF comm1] munionM_comp_fun_commute[OF comm2], THEN rel_funD, THEN rel_funD, rotated -1], assumption)
   subgoal premises [transfer_rule] by transfer_prover
   subgoal premises by transfer_prover
   done
 
 subsubsection \<open>Implementation using finite sets\<close>
 
 context 
   fixes return :: "('a fset, 'm) return"
     and bind :: "('a fset, 'm) bind"
     and funionM fUnionM
   defines "funionM m1 m2 \<equiv> bind m1 (\<lambda>A. bind m2 (\<lambda>B. return (A |\<union>| B)))"
     and "fUnionM \<equiv> ffold funionM (return {||})"
 begin
 
 definition fmerge :: "'a fset \<Rightarrow> ('a \<Rightarrow> 'm) \<Rightarrow> 'm"
 where "fmerge A f = fUnionM (fimage f A)"
 
 context
   assumes "monad_commute return bind"
   and "monad_duplicate return bind"
 begin
 
 interpretation monad_commute return bind by fact
 interpretation monad_duplicate return bind by fact
 interpretation nondetM_base return bind fmerge "{||}" "\<lambda>x. {|x|}" "(|\<union>|)" .
 
 lemma funionM_comp_fun_commute: "comp_fun_commute funionM"
   apply(unfold_locales)
   apply(simp add: fun_eq_iff bind_assoc return_bind funionM_def)
   apply(subst bind_commute)
   apply(simp add: funion_ac)
   done
 
 interpretation comp_fun_commute funionM by(rule funionM_comp_fun_commute)
 
 lemma funionM_comp_fun_idem: "comp_fun_idem funionM"
   by(unfold_locales)(simp add: fun_eq_iff funionM_def bind_assoc bind_duplicate return_bind)
 
 interpretation comp_fun_idem funionM by(rule funionM_comp_fun_idem)
 
 lemma fUnionM_empty [simp]: "fUnionM {||} = return {||}" by(simp add: fUnionM_def)
 lemma fUnionM_finset [simp]: "fUnionM (finsert x M) = funionM x (fUnionM M)" for x M
   by(simp add: fUnionM_def)
 lemma funionM_return_empty1 [simp]: "funionM (return {||}) x = x" for x
   by(simp add: funionM_def return_bind bind_return)
 lemma funionM_return_empty2 [simp]: "funionM x (return {||}) = x" for x
   by(simp add: funionM_def return_bind bind_return)
 lemma funionM_return_return [simp]: "funionM (return A) (return B) = return (A |\<union>| B)" for A B
   by(simp add: funionM_def return_bind)
 lemma funionM_assoc: "funionM (funionM x y) z = funionM x (funionM y z)" for x y z
   by(simp add: funionM_def bind_assoc return_bind funion_assoc)
 lemma funionM_commute: "funionM x y = funionM y x" for x y
   unfolding funionM_def by(subst bind_commute)(simp add: funion_commute)
 lemma funionM_fUnionM1: "funionM (fUnionM A) x = ffold funionM x A" for A x
   by(induction A arbitrary: x)(simp_all add: funionM_assoc)
 lemma funionM_fUnionM2: "funionM x (fUnionM A) = ffold funionM x A" for x A
   by(subst funionM_commute)(rule funionM_fUnionM1)
 lemma fUnionM_funion [simp]: "fUnionM (A |\<union>| B) = funionM (fUnionM A) (fUnionM B)" for A B
   by(subst funionM_fUnionM2)(simp add: fUnionM_def ffold_set_union)
 lemma fUnionM_return [simp]: "fUnionM (fimage (\<lambda>x. return {|x|}) A) = return A" for A
   by(induction A) simp_all
 lemma bind_funionM: "bind (funionM m m') f = funionM (bind m f) (bind m' f)"
   if "\<And>A B. f (A |\<union>| B) = bind (f A) (\<lambda>x. bind (f B) (\<lambda>y. return (x |\<union>| y)))" for m m' f
   apply(simp add: bind_assoc return_bind funionM_def that)
   apply(subst (2) bind_commute)
   apply simp
   done
 lemma fUnionM_return_fempty [simp]: "fUnionM (fimage (\<lambda>x. return {||}) A) = return {||}" for A
   by(induction A) simp_all
 lemma funionM_bind: "funionM (bind m f) (bind m g) = bind m (\<lambda>x. funionM (f x) (g x))" for m f g
   unfolding funionM_def bind_assoc by(subst bind_commute)(simp add: bind_duplicate)
 lemma fUnionM_funionM:
  "fUnionM ((\<lambda>y. funionM (f y) (g y)) |`| A) = funionM (fUnionM (f |`| A)) (fUnionM (g |`| A))" for f g A
   by(induction A)(simp_all add: funionM_assoc funionM_commute fun_left_comm)
 
 lemma fset_nondetM: "nondetM return bind fmerge {||} (\<lambda>x. {|x|}) (|\<union>|)"
 proof
   show "bind (fmerge y f) (\<lambda>A. fmerge A g) = fmerge y (\<lambda>x. bind (f x) (\<lambda>A. fmerge A g))" for y f g
     apply(induction y)
     apply(simp_all add: return_bind fmerge_def)
     apply(subst bind_funionM; simp add: funionM_def o_def fimage_funion)
     done
 
   show "fmerge {||} f = return {||}" for f by(simp add: fmerge_def)
   show "fmerge {|x|} f = f x" for x f by(simp add: fmerge_def)
   show "fmerge A (\<lambda>x. return {|x|}) = return A" for A by(simp add: fmerge_def)
   show "fmerge (A |\<union>| B) f = bind (fmerge A f) (\<lambda>A'. bind (fmerge B f) (\<lambda>B'. return (A' |\<union>| B')))"
     for f A B by(simp add: fmerge_def funionM_def fimage_funion)
 qed auto
 
 lemma fset_nondetM_ask:
   notes fset_nondetM[locale_witness]
   assumes [locale_witness]: "monad_reader return bind ask"
   shows "nondetM_ask return bind ask fmerge {||} (\<lambda>x. {|x|}) (|\<union>|)"
 proof
   interpret monad_reader return bind ask by fact
   show "fmerge A (\<lambda>x. ask (\<lambda>r. run_nondet (f x r))) = ask (\<lambda>r. fmerge A (\<lambda>x. run_nondet (f x r)))"
     for A and f :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'm) nondetT" unfolding fmerge_def
     by(induction A)(simp_all add: ask_const funionM_def bind_ask bind_ask2 ask_ask)
 qed
 
 lemmas fset_nondetMs [locale_witness] =
   nondetM_lemmas[OF fset_nondetM]
   nondetM_ask_lemmas[OF fset_nondetM_ask]
 
 
 context
   assumes "monad_discard return bind"
 begin
 
 interpretation monad_discard return bind by fact
 
 lemma fmerge_bind:
   "fmerge A (\<lambda>x. bind m' (\<lambda>A'. fmerge A' (f x))) = bind m' (\<lambda>A'. fmerge A (\<lambda>x. fmerge A' (f x)))"
   by(induction A)(simp_all add: fmerge_def bind_const funionM_bind)
 
 lemma fmerge_commute: "fmerge A (\<lambda>x. fmerge B (f x)) = fmerge B (\<lambda>y. fmerge A (\<lambda>x. f x y))"
   by(induction A)(simp_all add: fmerge_def fUnionM_funionM)
 
 lemma monad_commute_nondetT_fset [locale_witness]:
   "monad_commute return_nondet bind_nondet"
 proof
   show "bind_nondet m (\<lambda>x. bind_nondet m' (f x)) = bind_nondet m' (\<lambda>y. bind_nondet m (\<lambda>x. f x y))" for m m' f
     apply(rule nondetT.expand)
     apply(simp add: o_def)
     apply(subst fmerge_bind)
     apply(subst bind_commute)
     apply(subst fmerge_commute)
     apply(subst fmerge_bind[symmetric])
     apply(rule refl)
     done
 qed
 
 end
 
 end
 
 end
 
 lemma fmerge_parametric:
   includes lifting_syntax
   assumes return [transfer_rule]: "(rel_fset A ===> M) return1 return2"
     and bind [transfer_rule]: "(M ===> (rel_fset A ===> M) ===> M) bind1 bind2"
     and comm1: "monad_commute return1 bind1" "monad_duplicate return1 bind1"
     and comm2: "monad_commute return2 bind2" "monad_duplicate return2 bind2"
   shows "(rel_fset A ===> (A ===> M) ===> M) (fmerge return1 bind1) (fmerge return2 bind2)"
   unfolding fmerge_def
   apply(rule rel_funI)+
   apply(drule (1) fset.map_transfer[THEN rel_funD, THEN rel_funD])
   apply(rule ffold_parametric[OF _ funionM_comp_fun_idem[OF comm1] funionM_comp_fun_idem[OF comm2], THEN rel_funD, THEN rel_funD, rotated -1], assumption)
   subgoal premises [transfer_rule] by transfer_prover
   subgoal premises by transfer_prover
   done
 
 subsubsection \<open>Implementation using countable sets\<close>
 
 text \<open>For non-finite choices, we cannot generically construct the merge operation. So we formalize
   in a locale what can be proven generically and then prove instances of the locale for concrete
   locale implementations.
 
   We need two separate merge parameters because we must merge effects over choices (type @{typ 'c})
   and effects over the non-deterministic results (type @{typ 'a}) of computations.
 \<close>
 
 locale cset_nondetM_base =
   nondetM_base return bind merge cempty csingle cUn
   for return :: "('a cset, 'm) return"
   and bind :: "('a cset, 'm) bind"
   and merge :: "('a, 'm, 'a cset) merge"
   and mergec :: "('c, 'm, 'c cset) merge"
 begin
 
 definition altc_nondet :: "('c, ('a, 'm) nondetT) altc" where
   "altc_nondet A f = NondetT (mergec A (run_nondet \<circ> f))"
 
 lemma run_altc_nondet [simp]: "run_nondet (altc_nondet A f) = mergec A (run_nondet \<circ> f)"
   by(simp add: altc_nondet_def)
 
 end
 
 locale cset_nondetM =
   cset_nondetM_base return bind merge mergec
   +
   monad_commute return bind
   +
   monad_duplicate return bind
   for return :: "('a cset, 'm) return"
   and bind :: "('a cset, 'm) bind"
   and merge :: "('a, 'm, 'a cset) merge"
   and mergec :: "('c, 'm, 'c cset) merge"
   +
   assumes bind_merge_merge:
     "\<And>y f g. bind (merge y f) (\<lambda>A. merge A g) = merge y (\<lambda>x. bind (f x) (\<lambda>A. merge A g))"
   and merge_empty: "\<And>f. merge cempty f = return cempty"
   and merge_single: "\<And>x f. merge (csingle x) f = f x"
   and merge_single2: "\<And>A. merge A (\<lambda>x. return (csingle x)) = return A"
   and merge_union: "\<And>A B f. merge (cUn A B) f = bind (merge A f) (\<lambda>A'. bind (merge B f) (\<lambda>B'. return (cUn A' B')))"
   and bind_mergec_merge:
     "\<And>y f g. bind (mergec y f) (\<lambda>A. merge A g) = mergec y (\<lambda>x. bind (f x) (\<lambda>A. merge A g))"
   and mergec_single: "\<And>x f. mergec (csingle x) f = f x"
   and mergec_UNION: "\<And>C f g. mergec (cUNION C f) g = mergec C (\<lambda>x. mergec (f x) g)"
   and mergec_parametric [transfer_rule]:
     "\<And>R. bi_unique R \<Longrightarrow> rel_fun (rel_cset R) (rel_fun (rel_fun R (=)) (=)) mergec mergec"
 begin
 
 interpretation nondetM return bind merge cempty csingle cUn
   by(unfold_locales; (rule bind_merge_merge merge_empty merge_single merge_single2 merge_union | simp add: cUn_assoc)?)
 
 sublocale nondet: monad_altc return_nondet bind_nondet altc_nondet
   including lifting_syntax
 proof
   show "bind_nondet (altc_nondet C g) f = altc_nondet C (\<lambda>c. bind_nondet (g c) f)" for C g f
     by(rule nondetT.expand)(simp add: bind_mergec_merge o_def)
   show "altc_nondet (csingle x) f = f x" for x f
     by(rule nondetT.expand)(simp add: mergec_single)
   show "altc_nondet (cUNION C f) g = altc_nondet C (\<lambda>x. altc_nondet (f x) g)" for C f g
     by(rule nondetT.expand)(simp add: o_def mergec_UNION)
   show "(rel_cset R ===> (R ===> (=)) ===> (=)) altc_nondet altc_nondet" 
     if [transfer_rule]: "bi_unique R" for R
     unfolding altc_nondet_def by(transfer_prover)
 qed
 
 end
 
 locale cset_nondetM3 =
   cset_nondetM return bind merge mergec
   +
   three "TYPE('c)"
   for return :: "('a cset, 'm) return"
   and bind :: "('a cset, 'm) bind"
   and merge :: "('a, 'm, 'a cset) merge"
   and mergec :: "('c, 'm, 'c cset) merge"
 begin
 
 interpretation nondet: monad_altc3 return_nondet bind_nondet altc_nondet ..
 
 end
 
 paragraph \<open>Identity monad\<close>
 
 definition merge_id :: "('c, 'a cset id, 'c cset) merge" where
   "merge_id A f = return_id (cUNION A (extract \<circ> f))"
 
 lemma extract_merge_id [simp]: "extract (merge_id A f) = cUNION A (extract \<circ> f)"
   by(simp add: merge_id_def)
 
 lemma merge_id_parametric [transfer_rule]: includes lifting_syntax shows
   "(rel_cset A ===> (A ===> rel_id (rel_cset A)) ===> rel_id (rel_cset A)) merge_id merge_id"
   unfolding merge_id_def by transfer_prover
 
 lemma cset_nondetM_id [locale_witness]: "cset_nondetM return_id bind_id merge_id merge_id"
   including lifting_syntax
 proof(unfold_locales)
   show "bind_id (merge_id y f) (\<lambda>A. merge_id A g) = merge_id y (\<lambda>x. bind_id (f x) (\<lambda>A. merge_id A g))"
     for y and f :: "'c \<Rightarrow> 'd cset id" and g by(rule id.expand)(simp add: o_def cUNION_assoc)
   then show "bind_id (merge_id y f) (\<lambda>A. merge_id A g) = merge_id y (\<lambda>x. bind_id (f x) (\<lambda>A. merge_id A g))"
     for y and f :: "'c \<Rightarrow> 'd cset id" and g by this
   show "merge_id cempty f = return_id cempty" for f :: "'a \<Rightarrow> 'a cset id" by(rule id.expand) simp
   show "merge_id (csingle x) f = f x" for x and f :: "'c \<Rightarrow> 'a cset id" by(rule id.expand) simp
   then show "merge_id (csingle x) f = f x" for x and f :: "'c \<Rightarrow> 'a cset id" by this
   show "merge_id A (\<lambda>x. return_id (csingle x)) = return_id A" for A :: "'a cset"
     by(rule id.expand)(simp add: o_def)
   show "merge_id (cUn A B) f = bind_id (merge_id A f) (\<lambda>A'. bind_id (merge_id B f) (\<lambda>B'. return_id (cUn A' B')))"
     for A B and f :: "'a \<Rightarrow> 'a cset id" by(rule id.expand)(simp add: cUNION_cUn)   
   show "merge_id (cUNION C f) g = merge_id C (\<lambda>x. merge_id (f x) g)"
     for C and f :: "'b \<Rightarrow> 'b cset" and g :: "'b \<Rightarrow> 'a cset id"
     by(rule id.expand)(simp add: o_def cUNION_assoc)
   show "(rel_cset R ===> (R ===> (=)) ===> (=)) merge_id merge_id"
     if "bi_unique R" for R :: "'b \<Rightarrow> 'b \<Rightarrow> bool"
     unfolding merge_id_def by transfer_prover
 qed
 
 paragraph \<open>Reader monad transformer\<close>
 
 definition merge_env :: "('c, 'm, 'c cset) merge \<Rightarrow> ('c, ('r, 'm) envT, 'c cset) merge" where 
   "merge_env merge A f = EnvT (\<lambda>r. merge A (\<lambda>a. run_env (f a) r))" for merge
 
 lemma run_merge_env [simp]: "run_env (merge_env merge A f) r = merge A (\<lambda>a. run_env (f a) r)" for merge
   by(simp add: merge_env_def)
 
 lemma merge_env_parametric [transfer_rule]: includes lifting_syntax shows
   "((rel_cset C ===> (C ===> M) ===> M) ===> rel_cset C ===> (C ===> rel_envT R M) ===> rel_envT R M)
    merge_env merge_env"
   unfolding merge_env_def by transfer_prover
 
 lemma cset_nondetM_envT [locale_witness]: 
   fixes return :: "('a cset, 'm) return" 
     and bind :: "('a cset, 'm) bind"
     and merge :: "('a, 'm, 'a cset) merge"
     and mergec :: "('c, 'm, 'c cset) merge"
   assumes "cset_nondetM return bind merge mergec"
   shows "cset_nondetM (return_env return) (bind_env bind) (merge_env merge) (merge_env mergec)"
 proof -
   interpret cset_nondetM return bind merge by fact
   show ?thesis including lifting_syntax
   proof
     show "bind_env bind (merge_env merge y f) (\<lambda>A. merge_env merge A g) =
       merge_env merge y (\<lambda>x. bind_env bind (f x) (\<lambda>A. merge_env merge A g))"
       for y and f :: "'a \<Rightarrow> ('b, 'm) envT" and g
       by(rule envT.expand)(simp add: fun_eq_iff cUNION_assoc bind_merge_merge)
     show "merge_env merge cempty f = return_env return cempty" for f :: "'a \<Rightarrow> ('b, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff merge_empty)
     show "merge_env merge (csingle x) f = f x" for f :: "'a \<Rightarrow> ('b, 'm) envT" and x
       by(rule envT.expand)(simp add: fun_eq_iff merge_single)
     show "merge_env merge A (\<lambda>x. return_env return (csingle x)) = return_env return A" for A
       by(rule envT.expand)(simp add: fun_eq_iff merge_single2)
     show "merge_env merge (cUn A B) f =
       bind_env bind (merge_env merge A f) (\<lambda>A'. bind_env bind (merge_env merge B f) (\<lambda>B'. return_env return (cUn A' B')))"
       for A B and f :: "'a \<Rightarrow> ('b, 'm) envT" by(rule envT.expand)(simp add: fun_eq_iff merge_union)
     show "bind_env bind (merge_env mergec y f) (\<lambda>A. merge_env merge A g) =
       merge_env mergec y (\<lambda>x. bind_env bind (f x) (\<lambda>A. merge_env merge A g))"
       for y and f :: "'c \<Rightarrow> ('b, 'm) envT" and g
       by(rule envT.expand)(simp add: fun_eq_iff cUNION_assoc bind_mergec_merge)
     show "merge_env mergec (csingle x) f = f x" for f :: "'c \<Rightarrow> ('b, 'm) envT" and x
       by(rule envT.expand)(simp add: fun_eq_iff mergec_single)
     show "merge_env mergec (cUNION C f) g = merge_env mergec C (\<lambda>x. merge_env mergec (f x) g)"
       for C f and g :: "'c \<Rightarrow> ('b, 'm) envT"
       by(rule envT.expand)(simp add: fun_eq_iff mergec_UNION)
     show "(rel_cset R ===> (R ===> (=)) ===> (=)) (merge_env mergec) (merge_env mergec)" 
       if [transfer_rule]: "bi_unique R" for R
       unfolding merge_env_def by transfer_prover
   qed
 qed
 
 
 
 (* paragraph \<open>Exception monad transformer\<close>
 
 text \<open>Failure in the non-determinism transformer is absorbed by choice. So there is no way to handle 
   failures. In contrast, in this combination, we choose that failures abort all choices.\<close>
 
 context
   fixes return :: "('a cset option, 'm) return"
     and bind :: "('a cset option, 'm) bind"
     and merge :: "('a option, 'm, 'a option cset) merge"
 begin
 
 definition merge_option :: "('a, ('a cset, 'm) optionT, 'a cset) merge" where
   "merge_option A f = 
   OptionT (merge (cimage Some A) (\<lambda>x. case x of None \<Rightarrow> return None
                                       | Some x' \<Rightarrow> run_option (f x')))"
 lemma run_merge_optionT [simp]:
   "run_option (merge_option A f) = 
   merge (cimage Some A) (\<lambda>x. case x of None \<Rightarrow> return None | Some x' \<Rightarrow> run_option (f x'))"
   by(simp add: merge_option_def)
 
 definition return_optionT_cset :: "('a option cset, 'm) return" where
   "return_optionT_cset A = (if cin None A then return None else return (Some (cimage the A)))"
 
 definition bind_optionT_cset :: "('a option cset, 'm) bind" where
   "bind_optionT_cset m f = 
    bind m (\<lambda>x. case x of None \<Rightarrow> return None | Some A \<Rightarrow> f (cimage Some A))"
 
 (* lemma
   assumes "monad return_optionT_cset bind_optionT_cset"
   shows "monad return bind"
 proof -
   interpret monad return_optionT_cset bind_optionT_cset by fact
   show ?thesis
   proof(unfold_locales)
     show "bind (return x) f = f x" for x f
       using return_bind[of "case x of None \<Rightarrow> csingle None | Some A \<Rightarrow> cimage Some A" ff]
       apply(simp add: bind_optionT_cset_def return_optionT_cset_def split: option.split_asm)
     subgoal for m f g
       using bind_assoc[of m "\<lambda>A. if cin None A then return None else f (Some (cimage the A))" "\<lambda>A. if cin None A then return None else g (Some (cimage the A))"]
       apply(simp add: bind_optionT_cset_def)
       apply(subst (asm) if_distrib[where f="\<lambda>m. bind m _"])
  *)
 
 lemma cset_nondetM_optionT [locale_witness]:
   assumes "monad_commute return bind"
     and "monad_discard return bind"
     and "monad_duplicate return bind"
     and "cset_nondetM return_optionT_cset bind_optionT_cset merge"
   shows "cset_nondetM (return_option return) (bind_option return bind) merge_option"
 proof -
   interpret monad_commute return bind by fact
   interpret monad_discard return bind by fact
   interpret monad_duplicate return bind by fact
   interpret *: cset_nondetM return_optionT_cset bind_optionT_cset merge by fact
   show ?thesis
   proof
     show "bind_option return bind (merge_option y f)
         (\<lambda>A. merge_option A g) =
        merge_option y
         (\<lambda>x. bind_option return bind (f x) (\<lambda>A. merge_option A g))" for y f g
       apply(rule optionT.expand)
       apply(simp add: run_bind_option cong del: option.case_cong) *)
 
 
 subsection \<open>State transformer\<close>
 
 datatype ('s, 'm) stateT = StateT (run_state: "'s \<Rightarrow> 'm")
   for rel: rel_stateT'
 
 text \<open>
   We define a more general relator for @{typ "(_, _) stateT"} than the one generated
   by the datatype package such that we can also show parametricity in the state.
 \<close>
 
 context includes lifting_syntax begin
 
 definition rel_stateT :: "('s \<Rightarrow> 's' \<Rightarrow> bool) \<Rightarrow> ('m \<Rightarrow> 'm' \<Rightarrow> bool) \<Rightarrow> ('s, 'm) stateT \<Rightarrow> ('s', 'm') stateT \<Rightarrow> bool"
 where "rel_stateT S M m m' \<longleftrightarrow> (S ===> M) (run_state m) (run_state m')"
 
 lemma rel_stateT_eq [relator_eq]: "rel_stateT (=) (=) = (=)"
 by(auto simp add: rel_stateT_def fun_eq_iff rel_fun_eq intro: stateT.expand)
 
 lemma rel_stateT_mono [relator_mono]: "\<lbrakk> S' \<le> S; M \<le> M' \<rbrakk> \<Longrightarrow> rel_stateT S M \<le> rel_stateT S' M'"
 by(rule predicate2I)(simp add: rel_stateT_def fun_mono[THEN predicate2D]) 
 
 lemma StateT_parametric [transfer_rule]: "((S ===> M) ===> rel_stateT S M) StateT StateT"
 by(auto simp add: rel_stateT_def)
 
 lemma run_state_parametric [transfer_rule]: "(rel_stateT S M ===> S ===> M) run_state run_state"
 by(auto simp add: rel_stateT_def)
 
 lemma case_stateT_parametric [transfer_rule]: 
   "(((S ===> M) ===> A) ===> rel_stateT S M ===> A) case_stateT case_stateT"
 by(auto 4 3 split: stateT.split simp add: rel_stateT_def del: rel_funI intro!: rel_funI dest: rel_funD)
 
 lemma rec_stateT_parametric [transfer_rule]: 
   "(((S ===> M) ===> A) ===> rel_stateT S M ===> A) rec_stateT rec_stateT"
 apply(rule rel_funI)+
 subgoal for \<dots> m m' by(cases m; cases m')(auto 4 3 simp add: rel_stateT_def del: rel_funI intro!: rel_funI dest: rel_funD)
 done
 
 lemma rel_stateT_Grp: "rel_stateT (=) (BNF_Def.Grp UNIV f) = BNF_Def.Grp UNIV (map_stateT f)"
 by(auto simp add: fun_eq_iff Grp_def rel_stateT_def rel_fun_def stateT.map_sel intro: stateT.expand)
 
 end
 
 subsubsection \<open>Plain monad, get, and put\<close>
 
 context 
   fixes return :: "('a \<times> 's, 'm) return"
   and bind :: "('a \<times> 's, 'm) bind"
 begin
 
 primrec bind_state :: "('a, ('s, 'm) stateT) bind"
 where "bind_state (StateT x) f = StateT (\<lambda>s. bind (x s) (\<lambda>(a, s'). run_state (f a) s'))"
 
 definition return_state :: "('a, ('s, 'm) stateT) return"
 where "return_state x = StateT (\<lambda>s. return (x, s))"
 
 definition get_state :: "('s, ('s, 'm) stateT) get"
 where "get_state f = StateT (\<lambda>s. run_state (f s) s)"
 
 primrec put_state :: "('s, ('s, 'm) stateT) put"
 where "put_state s (StateT f) = StateT (\<lambda>_. f s)"
 
 lemma run_put_state [simp]: "run_state (put_state s m) s' = run_state m s"
 by(cases m) simp
 
 lemma run_get_state [simp]: "run_state (get_state f) s = run_state (f s) s"
 by(simp add: get_state_def)
 
 lemma run_bind_state [simp]:
   "run_state (bind_state x f) s = bind (run_state x s) (\<lambda>(a, s'). run_state (f a) s')"
 by(cases x)(simp)
 
 lemma run_return_state [simp]:
   "run_state (return_state x) s = return (x, s)"
 by(simp add: return_state_def)
 
 context
   assumes monad: "monad return bind"
 begin
 
 interpretation monad return bind by(fact monad)
 
 lemma monad_stateT [locale_witness]: "monad return_state bind_state" (is "monad ?return ?bind")
 proof
   show "?bind (?bind x f) g = ?bind x (\<lambda>x. ?bind (f x) g)" for x and f g :: "'a \<Rightarrow> ('s, 'm) stateT"
     by(rule stateT.expand ext)+(simp add: bind_assoc split_def)
   show "?bind (?return x) f = f x" for f :: "'a \<Rightarrow> ('s, 'm) stateT" and x
     by(rule stateT.expand ext)+(simp add: return_bind)
   show "?bind x ?return = x" for x
     by(rule stateT.expand ext)+(simp add: bind_return)
 qed
 
 lemma monad_state_stateT [locale_witness]:
   "monad_state return_state bind_state get_state put_state"
 proof
   show "put_state s (get_state f) = put_state s (f s)" for f :: "'s \<Rightarrow> ('s, 'm) stateT" and s :: "'s"
     by(rule stateT.expand)(simp add: get_state_def fun_eq_iff)
   show "get_state (\<lambda>s. get_state (f s)) = get_state (\<lambda>s. f s s)" for f :: "'s \<Rightarrow> 's \<Rightarrow> ('s, 'm) stateT"
     by(rule stateT.expand)(simp add: fun_eq_iff)
   show "put_state s (put_state s' m) = put_state s' m" for s s' :: 's and m :: "('s, 'm) stateT"
     by(rule stateT.expand)(simp add: fun_eq_iff)
   show "get_state (\<lambda>s :: 's. put_state s m) = m" for m :: "('s, 'm) stateT"
     by(rule stateT.expand)(simp add: fun_eq_iff)  
   show "get_state (\<lambda>_. m) = m" for m :: "('s, 'm) stateT"
     by(rule stateT.expand)(simp add: fun_eq_iff)
   show "bind_state (get_state f) g = get_state (\<lambda>s. bind_state (f s) g)" for f g
     by(rule stateT.expand)(simp add: fun_eq_iff)
   show "bind_state (put_state s m) f = put_state s (bind_state m f)" for s :: 's and m f
     by(rule stateT.expand)(simp add: fun_eq_iff)
 qed
 
 end
 
 text \<open>
   We cannot define a generic lifting operation for state like in Haskell.
   If we separate the monad type variable from the element type variable, then
   \<open>lift\<close> should have type \<open>'a 'm => (('a \<times> 's) 'm) stateT\<close>, but this means
   that the type of results must change, which does not work for monomorphic monads.
 
   Instead, we must lift all operations individually. \<open>lift_definition\<close> does not work
   because the monad transformer type is typically larger than the base type, but
   \<open>lift_definition\<close> only works if the lifted type is no bigger.
 \<close>
 
 subsubsection \<open>Failure\<close>
 
 context
   fixes fail :: "'m fail"
 begin
 
 definition fail_state :: "('s, 'm) stateT fail"
 where "fail_state = StateT (\<lambda>s. fail)"
 
 lemma run_fail_state [simp]: "run_state fail_state s = fail"
 by(simp add: fail_state_def)
 
 lemma monad_fail_stateT [locale_witness]:
   assumes "monad_fail return bind fail"
   shows "monad_fail return_state bind_state fail_state" (is "monad_fail ?return ?bind ?fail")
 proof -
   interpret monad_fail return bind fail by(fact assms)
   have "?bind ?fail f = ?fail" for f by(rule stateT.expand)(simp add: fun_eq_iff fail_bind)
   then show ?thesis by unfold_locales
 qed
 
 notepad begin
   text \<open>
     \<open>catch\<close> cannot be lifted through the state monad according to @{term monad_catch_state}
    because there is now way to communicate the state updates to the handler.
   \<close>
   fix catch :: "'m catch"
   assume "monad_catch return bind fail catch"
   then interpret monad_catch return bind fail catch .
 
   define catch_state :: "('s, 'm) stateT catch" where
     "catch_state m1 m2 = StateT (\<lambda>s. catch (run_state m1 s) (run_state m2 s))" for m1 m2
   have "monad_catch return_state bind_state fail_state catch_state"
     by(unfold_locales; rule stateT.expand; simp add: fun_eq_iff catch_state_def catch_return catch_fail catch_fail2 catch_assoc)
 end
 
 end
 
 subsubsection \<open>Reader\<close>
 
 context
   fixes ask :: "('r, 'm) ask"
 begin
 
 definition ask_state :: "('r, ('s, 'm) stateT) ask"
 where "ask_state f = StateT (\<lambda>s. ask (\<lambda>r. run_state (f r) s))"
 
 lemma run_ask_state [simp]:
   "run_state (ask_state f) s = ask (\<lambda>r. run_state (f r) s)"
 by(simp add: ask_state_def)
 
 lemma monad_reader_stateT [locale_witness]:
   assumes "monad_reader return bind ask"
   shows "monad_reader return_state bind_state ask_state"
 proof -
   interpret monad_reader return bind ask by(fact assms)
   show ?thesis
   proof
     show "ask_state (\<lambda>r. ask_state (f r)) = ask_state (\<lambda>r. f r r)" for f :: "'r \<Rightarrow> 'r \<Rightarrow> ('s, 'm) stateT"
       by(rule stateT.expand)(simp add: fun_eq_iff ask_ask)
     show "ask_state (\<lambda>_. x) = x" for x
       by(rule stateT.expand)(simp add: fun_eq_iff ask_const)
     show "bind_state (ask_state f) g = ask_state (\<lambda>r. bind_state (f r) g)" for f g
       by(rule stateT.expand)(simp add: fun_eq_iff bind_ask)
     show "bind_state m (\<lambda>x. ask_state (f x)) = ask_state (\<lambda>r. bind_state m (\<lambda>x. f x r))" for m f
       by(rule stateT.expand)(simp add: fun_eq_iff bind_ask2 split_def)
   qed
 qed
 
 lemma monad_reader_state_stateT [locale_witness]:
   assumes "monad_reader return bind ask"
   shows "monad_reader_state return_state bind_state ask_state get_state put_state"
 proof -
   interpret monad_reader return bind ask by(fact assms)
   show ?thesis
   proof
     show "ask_state (\<lambda>r. get_state (f r)) = get_state (\<lambda>s. ask_state (\<lambda>r. f r s))" for f
       by(rule stateT.expand)(simp add: fun_eq_iff)
     show "put_state m (ask_state f) = ask_state (\<lambda>r. put_state m (f r))" for m f
       by(rule stateT.expand)(simp add: fun_eq_iff)
   qed
 qed
 
 end
 
 subsubsection \<open>Probability\<close>
 
 definition altc_sample_state :: "('x \<Rightarrow> ('b \<Rightarrow> 'm) \<Rightarrow> 'm) \<Rightarrow> 'x \<Rightarrow> ('b \<Rightarrow> ('s, 'm) stateT) \<Rightarrow> ('s, 'm) stateT"
 where "altc_sample_state altc_sample p f = StateT (\<lambda>s. altc_sample p (\<lambda>x. run_state (f x) s))"
 
 lemma run_altc_sample_state [simp]:
   "run_state (altc_sample_state altc_sample p f) s = altc_sample p (\<lambda>x. run_state (f x) s)"
 by(simp add: altc_sample_state_def)
 
 context
   fixes sample :: "('p, 'm) sample"
 begin
 
 abbreviation sample_state :: "('p, ('s, 'm) stateT) sample" where
   "sample_state \<equiv> altc_sample_state sample"
 
 context
   assumes "monad_prob return bind sample"
 begin
 
 interpretation monad_prob return bind sample by(fact)
 
 lemma monad_prob_stateT [locale_witness]: "monad_prob return_state bind_state sample_state"
   including lifting_syntax
 proof
   note sample_parametric[transfer_rule]
   show "sample_state p (\<lambda>_. x) = x" for p x
     by(rule stateT.expand)(simp add: fun_eq_iff sample_const)
   show "sample_state (return_pmf x) f = f x" for f x
     by(rule stateT.expand)(simp add: fun_eq_iff sample_return_pmf)
   show "sample_state (bind_pmf p f) g = sample_state p (\<lambda>x. sample_state (f x) g)" for p f g
     by(rule stateT.expand)(simp add: fun_eq_iff sample_bind_pmf)
   show "sample_state p (\<lambda>x. sample_state q (f x)) = sample_state q (\<lambda>y. sample_state p (\<lambda>x. f x y))" for p q f
     by(rule stateT.expand)(auto simp add: fun_eq_iff intro: sample_commute)
   show "bind_state (sample_state p f) g = sample_state p (\<lambda>x. bind_state (f x) g)" for p f g
     by(rule stateT.expand)(simp add: fun_eq_iff bind_sample1)
   show "bind_state m (\<lambda>y. sample_state p (f y)) = sample_state p (\<lambda>x. bind_state m (\<lambda>y. f y x))" for m p f
     by(rule stateT.expand)(simp add: fun_eq_iff bind_sample2 split_def)
   show "(rel_pmf R ===> (R ===> (=)) ===> (=)) sample_state sample_state"
     if [transfer_rule]: "bi_unique R" for R unfolding altc_sample_state_def by transfer_prover
 qed
 
 lemma monad_state_prob_stateT [locale_witness]:
   "monad_state_prob return_state bind_state get_state put_state sample_state"
 proof
   show "sample_state p (\<lambda>x. get_state (f x)) = get_state (\<lambda>s. sample_state p (\<lambda>x. f x s))" for p f
     by(rule stateT.expand)(simp add: fun_eq_iff)
 qed
 
 end
 
 end
 
 subsubsection \<open>Writer\<close>
 
 context
   fixes tell :: "('w, 'm) tell"
 begin
 
 definition tell_state :: "('w, ('s, 'm) stateT) tell"
 where "tell_state w m = StateT (\<lambda>s. tell w (run_state m s))"
 
 lemma run_tell_state [simp]: "run_state (tell_state w m) s = tell w (run_state m s)"
 by(simp add: tell_state_def)
 
 lemma monad_writer_stateT [locale_witness]:
   assumes "monad_writer return bind tell"
   shows "monad_writer return_state bind_state tell_state"
 proof -
   interpret monad_writer return bind tell by(fact assms)
   show ?thesis
   proof
     show "bind_state (tell_state w m) f = tell_state w (bind_state m f)" for w m f
       by(rule stateT.expand)(simp add: bind_tell fun_eq_iff)
   qed
 qed
 
 end
 
 subsubsection \<open>Binary Non-determinism\<close>
 
 context
   fixes alt :: "'m alt"
 begin
 
 definition alt_state :: "('s, 'm) stateT alt"
 where "alt_state m1 m2 = StateT (\<lambda>s. alt (run_state m1 s) (run_state m2 s))"
 
 lemma run_alt_state [simp]: "run_state (alt_state m1 m2) s = alt (run_state m1 s) (run_state m2 s)"
 by(simp add: alt_state_def)
 
 context assumes "monad_alt return bind alt" begin
 
 interpretation monad_alt return bind alt by fact
 
 lemma monad_alt_stateT [locale_witness]: "monad_alt return_state bind_state alt_state"
 proof
   show "alt_state (alt_state m1 m2) m3 = alt_state m1 (alt_state m2 m3)" for m1 m2 m3
     by(rule stateT.expand)(simp add: alt_assoc fun_eq_iff)
   show "bind_state (alt_state m m') f = alt_state (bind_state m f) (bind_state m' f)" for m m' f
     by(rule stateT.expand)(simp add: bind_alt1 fun_eq_iff)
 qed
 
 lemma monad_state_alt_stateT [locale_witness]:
   "monad_state_alt return_state bind_state get_state put_state alt_state"
 proof
   show "alt_state (get_state f) (get_state g) = get_state (\<lambda>x. alt_state (f x) (g x))"
     for f g by(rule stateT.expand)(simp add: fun_eq_iff)
   show "alt_state (put_state s m) (put_state s m') = put_state s (alt_state m m')"
     for s m m' by(rule stateT.expand)(simp add: fun_eq_iff)
 qed
 
 end
 
 lemma monad_fail_alt_stateT [locale_witness]:
   fixes fail
   assumes "monad_fail_alt return bind fail alt"
   shows "monad_fail_alt return_state bind_state (fail_state fail) alt_state"
 proof -
   interpret monad_fail_alt return bind fail alt by fact
   show ?thesis
   proof
     show  "alt_state (fail_state fail) m = m" for m
       by(rule stateT.expand)(simp add: fun_eq_iff alt_fail1)
     show "alt_state m (fail_state fail) = m" for m
       by(rule stateT.expand)(simp add: fun_eq_iff alt_fail2)
   qed
 qed
 
 end
 
 subsubsection \<open>Countable Non-determinism\<close>
 
 context
   fixes altc :: "('c, 'm) altc"
 begin
 
 abbreviation altc_state :: "('c, ('s, 'm) stateT) altc"
 where "altc_state \<equiv> altc_sample_state altc"
 
 context
   includes lifting_syntax
   assumes "monad_altc return bind altc" 
 begin
 
 interpretation monad_altc return bind altc by fact
 
 lemma monad_altc_stateT [locale_witness]: "monad_altc return_state bind_state altc_state"
 proof
   note altc_parametric[transfer_rule]
   show "bind_state (altc_state C g) f = altc_state C (\<lambda>c. bind_state (g c) f)" for C g f
     by(rule stateT.expand)(simp add: fun_eq_iff bind_altc1)
   show "altc_state (csingle x) f = f x" for x f
     by(rule stateT.expand)(simp add: fun_eq_iff altc_single)
   show "altc_state (cUNION C f) g = altc_state C (\<lambda>x. altc_state (f x) g)" for C f g
     by(rule stateT.expand)(simp add: fun_eq_iff altc_cUNION)
   show "(rel_cset R ===> (R ===> (=)) ===> (=)) altc_state altc_state" if [transfer_rule]: "bi_unique R" for R
     unfolding altc_sample_state_def by transfer_prover
 qed
 
 lemma monad_state_altc_stateT [locale_witness]:
   "monad_state_altc return_state bind_state get_state put_state altc_state"
 proof
   show "altc_state C (\<lambda>c. get_state (f c)) = get_state (\<lambda>s. altc_state C (\<lambda>c. f c s))"
     for C and f :: "'c \<Rightarrow> 's \<Rightarrow> ('s, 'm) stateT" by(rule stateT.expand)(simp add: fun_eq_iff)
   show "altc_state C (\<lambda>c. put_state s (f c)) = put_state s (altc_state C f)"
     for C s and f :: "'c \<Rightarrow> ('s, 'm) stateT" by(rule stateT.expand)(simp add: fun_eq_iff)
 qed
 
 end
 
 lemma monad_altc3_stateT [locale_witness]:
   assumes "monad_altc3 return bind altc"
   shows "monad_altc3 return_state bind_state altc_state"
 proof -
   interpret monad_altc3 return bind altc by fact
   show ?thesis ..
 qed
 
 end
 
 subsubsection \<open>Resumption\<close>
 
 context
   fixes pause :: "('o, 'i, 'm) pause"
 begin
 
 definition pause_state :: "('o, 'i, ('s, 'm) stateT) pause"
 where "pause_state out c = StateT (\<lambda>s. pause out (\<lambda>i. run_state (c i) s))"
 
 lemma run_pause_state [simp]:
   "run_state (pause_state out c) s = pause out (\<lambda>i. run_state (c i) s)"
 by(simp add: pause_state_def)
 
 lemma monad_resumption_stateT [locale_witness]:
   assumes "monad_resumption return bind pause"
   shows "monad_resumption return_state bind_state pause_state"
 proof -
   interpret monad_resumption return bind pause by fact
   show ?thesis
   proof
     show "bind_state (pause_state out c) f = pause_state out (\<lambda>i. bind_state (c i) f)" for out c f
       by(rule stateT.expand)(simp add: fun_eq_iff bind_pause)
   qed
 qed
 
 end
 
 end
 
 subsubsection \<open>Parametricity\<close>
 
 context includes lifting_syntax begin
 
 lemma return_state_parametric [transfer_rule]:
   "((rel_prod A S ===> M) ===> A ===> rel_stateT S M) return_state return_state"
 unfolding return_state_def by transfer_prover
 
 lemma bind_state_parametric [transfer_rule]:
   "((M ===> (rel_prod A S ===> M) ===> M) ===> rel_stateT S M ===> (A ===> rel_stateT S M) ===> rel_stateT S M)
    bind_state bind_state"
 unfolding bind_state_def by transfer_prover
 
 lemma get_state_parametric [transfer_rule]:
   "((S ===> rel_stateT S M) ===> rel_stateT S M) get_state get_state"
 unfolding get_state_def by transfer_prover
 
 lemma put_state_parametric [transfer_rule]:
   "(S ===> rel_stateT S M ===> rel_stateT S M) put_state put_state"
 unfolding put_state_def by transfer_prover
 
 lemma fail_state_parametric [transfer_rule]: "(M ===> rel_stateT S M) fail_state fail_state"
 unfolding fail_state_def by transfer_prover
 
 lemma ask_state_parametric [transfer_rule]:
   "(((R ===> M) ===> M) ===> (R ===> rel_stateT S M) ===> rel_stateT S M) ask_state ask_state"
 unfolding ask_state_def by transfer_prover
 
 lemma altc_sample_state_parametric [transfer_rule]:
   "((X ===> (P ===> M) ===> M) ===> X ===> (P ===> rel_stateT S M) ===> rel_stateT S M)
    altc_sample_state altc_sample_state"
 unfolding altc_sample_state_def by transfer_prover
 
 lemma tell_state_parametric [transfer_rule]:
   "((W ===> M ===> M) ===> W ===> rel_stateT S M ===> rel_stateT S M)
    tell_state tell_state"
 unfolding tell_state_def by transfer_prover
 
 lemma alt_state_parametric [transfer_rule]:
   "((M ===> M ===> M) ===> rel_stateT S M ===> rel_stateT S M ===> rel_stateT S M)
    alt_state alt_state"
 unfolding alt_state_def by transfer_prover
 
 lemma pause_state_parametric [transfer_rule]:
   "((Out ===> (In ===> M) ===> M) ===> Out ===> (In ===> rel_stateT S M) ===> rel_stateT S M)
    pause_state pause_state"
 unfolding pause_state_def by transfer_prover
 
 end
 
 
 subsection \<open>Writer monad transformer\<close>
 
 text \<open>
   We implement a simple writer monad which collects all the output in a list. It would also have
   been possible to use a monoid instead. The phantom type variables @{typ 'a} and @{typ 'w} are needed to
   avoid hidden polymorphism when overloading the monad operations for the writer monad
   transformer.
 \<close>
 
 datatype ('w, 'a, 'm) writerT = WriterT (run_writer: 'm)
 
 context
   fixes return :: "('a \<times> 'w list, 'm) return"
   and bind :: "('a \<times> 'w list, 'm) bind"
 begin
 
 definition return_writer :: "('a, ('w, 'a, 'm) writerT) return"
 where "return_writer x = WriterT (return (x, []))"
 
 definition bind_writer :: "('a, ('w, 'a, 'm) writerT) bind"
 where "bind_writer m f = WriterT (bind (run_writer m) (\<lambda>(a, ws). bind (run_writer (f a)) (\<lambda>(b, ws'). return (b, ws @ ws'))))"
 
 definition tell_writer :: "('w, ('w, 'a, 'm) writerT) tell"
 where "tell_writer w m = WriterT (bind (run_writer m) (\<lambda>(a, ws). return (a, w # ws)))"
 
 lemma run_return_writer [simp]: "run_writer (return_writer x) = return (x, [])"
 by(simp add: return_writer_def)
 
 lemma run_bind_writer [simp]:
   "run_writer (bind_writer m f) = bind (run_writer m) (\<lambda>(a, ws). bind (run_writer (f a)) (\<lambda>(b, ws'). return (b, ws @ ws')))"
 by(simp add: bind_writer_def)
 
 lemma run_tell_writer [simp]:
   "run_writer (tell_writer w m) = bind (run_writer m) (\<lambda>(a, ws). return (a, w # ws))"
 by(simp add: tell_writer_def)
 
 context
   assumes "monad return bind"
 begin
 
 interpretation monad return bind by fact
 
 lemma monad_writerT [locale_witness]: "monad return_writer bind_writer"
 proof
   show "bind_writer (bind_writer x f) g = bind_writer x (\<lambda>y. bind_writer (f y) g)" for x f g
     by(rule writerT.expand)(simp add: bind_assoc split_def return_bind)
   show "bind_writer (return_writer x) f = f x" for  x f
     by(rule writerT.expand)(simp add: bind_return return_bind)
   show "bind_writer x return_writer = x" for x
     by(rule writerT.expand)(simp add: bind_return return_bind)
 qed
 
 lemma monad_writer_writerT [locale_witness]: "monad_writer return_writer bind_writer tell_writer"
 proof
   show "bind_writer (tell_writer w m) f = tell_writer w (bind_writer m f)" for w m f
     by(rule writerT.expand)(simp add: bind_assoc split_def return_bind)
 qed
 
 end
 
 subsubsection \<open>Failure\<close>
 
 context
   fixes fail :: "'m fail"
 begin
 
 definition fail_writer :: "('w, 'a, 'm) writerT fail"
 where "fail_writer = WriterT fail"
 
 lemma run_fail_writer [simp]: "run_writer fail_writer = fail"
 by(simp add: fail_writer_def)
 
 lemma monad_fail_writerT [locale_witness]:
   assumes "monad_fail return bind fail"
   shows "monad_fail return_writer bind_writer fail_writer"
 proof -
   interpret monad_fail return bind fail by fact
   show ?thesis
   proof
     show "bind_writer fail_writer f = fail_writer" for f
       by(rule writerT.expand)(simp add: fail_bind)
   qed
 qed
 
 text \<open>
   Just like for the state monad, we cannot lift @{term catch} because the output before the failure would be lost.
 \<close>
 
 subsubsection \<open>State\<close>
 
 context
   fixes get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
 begin
 
 definition get_writer :: "('s, ('w, 'a, 'm) writerT) get"
 where "get_writer f = WriterT (get (\<lambda>s. run_writer (f s)))"
 
 definition put_writer :: "('s, ('w, 'a, 'm) writerT) put"
 where "put_writer s m = WriterT (put s (run_writer m))"
 
 lemma run_get_writer [simp]: "run_writer (get_writer f) = get (\<lambda>s. run_writer (f s))"
 by(simp add: get_writer_def)
 
 lemma run_put_writer [simp]: "run_writer (put_writer s m) = put s (run_writer m)"
 by(simp add: put_writer_def)
 
 lemma monad_state_writerT [locale_witness]:
   assumes "monad_state return bind get put"
   shows "monad_state return_writer bind_writer get_writer put_writer"
 proof -
   interpret monad_state return bind get put by fact
   show ?thesis
   proof
     show "put_writer s (get_writer f) = put_writer s (f s)" for s f
       by(rule writerT.expand)(simp add: put_get)
     show "get_writer (\<lambda>s. get_writer (f s)) = get_writer (\<lambda>s. f s s)" for f
       by(rule writerT.expand)(simp add: get_get)
     show "put_writer s (put_writer s' m) = put_writer s' m" for s s' m
       by(rule writerT.expand)(simp add: put_put)
     show "get_writer (\<lambda>s. put_writer s m) = m" for m
       by(rule writerT.expand)(simp add: get_put)
     show "get_writer (\<lambda>_. m) = m" for m
       by(rule writerT.expand)(simp add: get_const)
     show "bind_writer (get_writer f) g = get_writer (\<lambda>s. bind_writer (f s) g)" for f g
       by(rule writerT.expand)(simp add: bind_get)
     show "bind_writer (put_writer s m) f = put_writer s (bind_writer m f)" for s m f
       by(rule writerT.expand)(simp add: bind_put)
   qed
 qed
 
 subsubsection  \<open>Probability\<close>
 
 definition altc_sample_writer :: "('x \<Rightarrow> ('b \<Rightarrow> 'm) \<Rightarrow> 'm) \<Rightarrow> 'x \<Rightarrow> ('b \<Rightarrow> ('w, 'a, 'm) writerT) \<Rightarrow> ('w, 'a, 'm) writerT"
 where "altc_sample_writer altc_sample p f = WriterT (altc_sample p (\<lambda>p. run_writer (f p)))"
 
 lemma run_altc_sample_writer [simp]:
   "run_writer (altc_sample_writer altc_sample p f) = altc_sample p (\<lambda>p. run_writer (f p))"
 by(simp add: altc_sample_writer_def)
 
 
 context
   fixes sample :: "('p, 'm) sample"
 begin
 
 abbreviation sample_writer :: "('p, ('w, 'a, 'm) writerT) sample"
 where "sample_writer \<equiv> altc_sample_writer sample"
 
 lemma monad_prob_writerT [locale_witness]:
   assumes "monad_prob return bind sample"
   shows "monad_prob return_writer bind_writer sample_writer"
 proof -
   interpret monad_prob return bind sample by fact
   note sample_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "sample_writer p (\<lambda>_. m) = m" for p m
       by(rule writerT.expand)(simp add: sample_const)
     show "sample_writer (return_pmf x) f = f x" for x f
       by(rule writerT.expand)(simp add: sample_return_pmf)
     show "sample_writer (p \<bind> f) g = sample_writer p (\<lambda>x. sample_writer (f x) g)" for p f g
       by(rule writerT.expand)(simp add: sample_bind_pmf)
     show "sample_writer p (\<lambda>x. sample_writer q (f x)) = sample_writer q (\<lambda>y. sample_writer p (\<lambda>x. f x y))"
       for p q f by(rule writerT.expand)(auto intro: sample_commute)
     show "bind_writer (sample_writer p f) g = sample_writer p (\<lambda>x. bind_writer (f x) g)" for p f g
       by(rule writerT.expand)(simp add: bind_sample1)
     show "bind_writer m (\<lambda>y. sample_writer p (f y)) = sample_writer p (\<lambda>x. bind_writer m (\<lambda>y. f y x))"
       for m p f by(rule writerT.expand)(simp add: bind_sample2[symmetric] bind_sample1 split_def)
     show "(rel_pmf R ===> (R ===> (=)) ===> (=)) sample_writer sample_writer"
       if [transfer_rule]: "bi_unique R" for R unfolding altc_sample_writer_def by transfer_prover
   qed
 qed
 
 lemma monad_state_prob_writerT [locale_witness]:
   assumes "monad_state_prob return bind get put sample"
   shows "monad_state_prob return_writer bind_writer get_writer put_writer sample_writer"
 proof -
   interpret monad_state_prob return bind get put sample by fact
   show ?thesis
   proof
     show "sample_writer p (\<lambda>x. get_writer (f x)) = get_writer (\<lambda>s. sample_writer p (\<lambda>x. f x s))" for p f
       by(rule writerT.expand)(simp add: sample_get)
   qed
 qed
 
 end
 
 subsubsection \<open>Reader\<close>
 
 context
   fixes ask :: "('r, 'm) ask"
 begin
 
 definition ask_writer :: "('r, ('w, 'a, 'm) writerT) ask"
 where "ask_writer f = WriterT (ask (\<lambda>r. run_writer (f r)))"
 
 lemma run_ask_writer [simp]: "run_writer (ask_writer f) = ask (\<lambda>r. run_writer (f r))"
 by(simp add: ask_writer_def)
 
 lemma monad_reader_writerT [locale_witness]:
   assumes "monad_reader return bind ask"
   shows "monad_reader return_writer bind_writer ask_writer"
 proof -
   interpret monad_reader return bind ask by fact
   show ?thesis
   proof
     show "ask_writer (\<lambda>r. ask_writer (f r)) = ask_writer (\<lambda>r. f r r)" for f
       by(rule writerT.expand)(simp add: ask_ask)
     show "ask_writer (\<lambda>_. m) = m" for m
       by(rule writerT.expand)(simp add: ask_const)
     show "bind_writer (ask_writer f) g = ask_writer (\<lambda>r. bind_writer (f r) g)" for f g
       by(rule writerT.expand)(simp add: bind_ask)
     show "bind_writer m (\<lambda>x. ask_writer (f x)) = ask_writer (\<lambda>r. bind_writer m (\<lambda>x. f x r))"
       for m f by(rule writerT.expand)(simp add: split_def bind_ask2[symmetric] bind_ask)
   qed
 qed
 
 lemma monad_reader_state_writerT [locale_witness]:
   assumes "monad_reader_state return bind ask get put"
   shows "monad_reader_state return_writer bind_writer ask_writer get_writer put_writer"
 proof -
   interpret monad_reader_state return bind ask get put by fact
   show ?thesis
   proof
     show "ask_writer (\<lambda>r. get_writer (f r)) = get_writer (\<lambda>s. ask_writer (\<lambda>r. f r s))"
       for f by(rule writerT.expand)(simp add: ask_get)
     show "put_writer s (ask_writer f) = ask_writer (\<lambda>r. put_writer s (f r))" for s f
       by(rule writerT.expand)(simp add: put_ask)
   qed
 qed
 
 end
 
 subsubsection \<open>Resumption\<close>
 
 context
   fixes pause :: "('o, 'i, 'm) pause"
 begin
 
 definition pause_writer :: "('o, 'i, ('w, 'a, 'm) writerT) pause"
 where "pause_writer out c = WriterT (pause out (\<lambda>input. run_writer (c input)))"
 
 lemma run_pause_writer [simp]:
   "run_writer (pause_writer out c) = pause out (\<lambda>input. run_writer (c input))"
 by(simp add: pause_writer_def)
 
 lemma monad_resumption_writerT [locale_witness]:
   assumes "monad_resumption return bind pause"
   shows "monad_resumption return_writer bind_writer pause_writer"
 proof -
   interpret monad_resumption return bind pause by fact
   show ?thesis
   proof
     show "bind_writer (pause_writer out c) f = pause_writer out (\<lambda>i. bind_writer (c i) f)" for out c f
       by(rule writerT.expand)(simp add: bind_pause)
   qed
 qed
 
 end
 
 subsubsection \<open>Binary Non-determinism\<close>
 
 context
   fixes alt :: "'m alt"
 begin
 
 definition alt_writer :: "('w, 'a, 'm) writerT alt"
 where "alt_writer m m' = WriterT (alt (run_writer m) (run_writer m'))"
 
 lemma run_alt_writer [simp]: "run_writer (alt_writer m m') = alt (run_writer m) (run_writer m')"
 by(simp add: alt_writer_def)
 
 lemma monad_alt_writerT [locale_witness]:
   assumes "monad_alt return bind alt"
   shows "monad_alt return_writer bind_writer alt_writer"
 proof -
   interpret monad_alt return bind alt by fact
   show ?thesis
   proof
     show "alt_writer (alt_writer m1 m2) m3 = alt_writer m1 (alt_writer m2 m3)" 
       for m1 m2 m3 by(rule writerT.expand)(simp add: alt_assoc)
     show "bind_writer (alt_writer m m') f = alt_writer (bind_writer m f) (bind_writer m' f)"
       for m m' f by(rule writerT.expand)(simp add: bind_alt1)
   qed
 qed
 
 lemma monad_fail_alt_writerT [locale_witness]:
   assumes "monad_fail_alt return bind fail alt"
   shows "monad_fail_alt return_writer bind_writer fail_writer alt_writer"
 proof -
   interpret monad_fail_alt return bind fail alt by fact
   show ?thesis
   proof
     show "alt_writer fail_writer m = m" for m
       by(rule writerT.expand)(simp add: alt_fail1)
     show "alt_writer m fail_writer = m" for m
       by(rule writerT.expand)(simp add: alt_fail2)
   qed
 qed
 
 lemma monad_state_alt_writerT [locale_witness]:
   assumes "monad_state_alt return bind get put alt"
   shows "monad_state_alt return_writer bind_writer get_writer put_writer alt_writer"
 proof -
   interpret monad_state_alt return bind get put alt by fact
   show ?thesis
   proof
     show "alt_writer (get_writer f) (get_writer g) = get_writer (\<lambda>x. alt_writer (f x) (g x))"
       for f g by(rule writerT.expand)(simp add: alt_get)
     show "alt_writer (put_writer s m) (put_writer s m') = put_writer s (alt_writer m m')"
       for s m m' by(rule writerT.expand)(simp add: alt_put)
   qed
 qed
 
 end
 
 subsubsection \<open>Countable Non-determinism\<close>
 
 context
   fixes altc :: "('c, 'm) altc"
 begin
 
 abbreviation altc_writer :: "('c, ('w, 'a, 'm) writerT) altc"
 where "altc_writer \<equiv> altc_sample_writer altc"
 
 
 lemma monad_altc_writerT [locale_witness]:
   assumes "monad_altc return bind altc"
   shows "monad_altc return_writer bind_writer altc_writer"
 proof -
   interpret monad_altc return bind altc by fact
   note altc_parametric[transfer_rule]
   show ?thesis including lifting_syntax
   proof
     show "bind_writer (altc_writer C g) f = altc_writer C (\<lambda>c. bind_writer (g c) f)" for C g f
       by(rule writerT.expand)(simp add: bind_altc1 o_def)
     show "altc_writer (csingle x) f = f x" for x f
       by(rule writerT.expand)(simp add: altc_single)
     show "altc_writer (cUNION C f) g = altc_writer C (\<lambda>x. altc_writer (f x) g)" for C f g
       by(rule writerT.expand)(simp add: altc_cUNION o_def)
     show "(rel_cset R ===> (R ===> (=)) ===> (=)) altc_writer altc_writer"
       if [transfer_rule]: "bi_unique R" for R unfolding altc_sample_writer_def by transfer_prover
   qed
 qed
 
 lemma monad_altc3_writerT [locale_witness]:
   assumes "monad_altc3 return bind altc"
   shows "monad_altc3 return_writer bind_writer altc_writer"
 proof -
   interpret monad_altc3 return bind altc by fact
   show ?thesis ..
 qed
 
 lemma monad_state_altc_writerT [locale_witness]:
   assumes "monad_state_altc return bind get put altc"
   shows "monad_state_altc return_writer bind_writer get_writer put_writer altc_writer"
 proof -
   interpret monad_state_altc return bind get put altc by fact
   show ?thesis
   proof
     show "altc_writer C (\<lambda>c. get_writer (f c)) = get_writer (\<lambda>s. altc_writer C (\<lambda>c. f c s))"
       for C and f :: "'c \<Rightarrow> 's \<Rightarrow> ('w, 'a, 'm) writerT" by(rule writerT.expand)(simp add: o_def altc_get)
     show "altc_writer C (\<lambda>c. put_writer s (f c)) = put_writer s (altc_writer C f)"
       for C s and f :: "'c \<Rightarrow> ('w, 'a, 'm) writerT" by(rule writerT.expand)(simp add: o_def altc_put)
   qed
 qed
 
 end
 
 end
 
 end
 
 end
 
 subsubsection \<open>Parametricity\<close>
 
 context includes lifting_syntax begin
 
 lemma return_writer_parametric [transfer_rule]:
   "((rel_prod A (list_all2 W) ===> M) ===> A ===> rel_writerT W A M) return_writer return_writer"
 unfolding return_writer_def by transfer_prover
 
 lemma bind_writer_parametric [transfer_rule]:
   "((rel_prod A (list_all2 W) ===> M) ===> (M ===> (rel_prod A (list_all2 W) ===> M) ===> M)
    ===> rel_writerT W A M ===> (A ===> rel_writerT W A M) ===> rel_writerT W A M)
    bind_writer bind_writer"
 unfolding bind_writer_def by transfer_prover
 
 lemma tell_writer_parametric [transfer_rule]:
   "((rel_prod A (list_all2 W) ===> M) ===> (M ===> (rel_prod A (list_all2 W) ===> M) ===> M)
    ===> W ===> rel_writerT W A M ===> rel_writerT W A M)
    tell_writer tell_writer"
 unfolding tell_writer_def by transfer_prover
 
 lemma ask_writer_parametric [transfer_rule]: 
   "(((R ===> M) ===> M) ===> (R ===> rel_writerT W A M) ===> rel_writerT W A M) ask_writer ask_writer"
 unfolding ask_writer_def by transfer_prover
 
 lemma fail_writer_parametric [transfer_rule]:
   "(M ===> rel_writerT W A M) fail_writer fail_writer"
 unfolding fail_writer_def by transfer_prover
 
 lemma get_writer_parametric [transfer_rule]:
   "(((S ===> M) ===> M) ===> (S ===> rel_writerT W A M) ===> rel_writerT W A M) get_writer get_writer"
 unfolding get_writer_def by transfer_prover
 
 lemma put_writer_parametric [transfer_rule]:
   "((S ===> M ===> M) ===> S ===> rel_writerT W A M ===> rel_writerT W A M) put_writer put_writer"
 unfolding put_writer_def by transfer_prover
 
 lemma altc_sample_writer_parametric [transfer_rule]:
   "((X ===> (P ===> M) ===> M) ===> X ===> (P ===> rel_writerT W A M) ===> rel_writerT W A M)
   altc_sample_writer altc_sample_writer"
 unfolding altc_sample_writer_def by transfer_prover
 
 lemma alt_writer_parametric [transfer_rule]:
   "((M ===> M ===> M) ===> rel_writerT W A M ===> rel_writerT W A M ===> rel_writerT W A M)
    alt_writer alt_writer"
 unfolding alt_writer_def by transfer_prover
 
 lemma pause_writer_parametric [transfer_rule]:
   "((Out ===> (In ===> M) ===> M) ===> Out ===> (In ===> rel_writerT W A M) ===> rel_writerT W A M)
    pause_writer pause_writer"
 unfolding pause_writer_def by transfer_prover
 
 end
 
 subsection \<open>Continuation monad transformer\<close>
 
 datatype ('a, 'm) contT = ContT (run_cont: "('a \<Rightarrow> 'm) \<Rightarrow> 'm")
 
 subsubsection \<open>CallCC\<close>
 
 type_synonym ('a, 'm) callcc = "(('a \<Rightarrow> 'm) \<Rightarrow> 'm) \<Rightarrow> 'm"
 
 definition callcc_cont :: "('a, ('a, 'm) contT) callcc"
 where "callcc_cont f = ContT (\<lambda>k. run_cont (f (\<lambda>x. ContT (\<lambda>_. k x))) k)"
 
 lemma run_callcc_cont [simp]: "run_cont (callcc_cont f) k = run_cont (f (\<lambda>x. ContT (\<lambda>_. k x))) k"
 by(simp add: callcc_cont_def)
 
 subsubsection \<open>Plain monad\<close>
 
 definition return_cont :: "('a, ('a, 'm) contT) return"
 where "return_cont x = ContT (\<lambda>k. k x)"
 
 definition bind_cont :: "('a, ('a, 'm) contT) bind"
 where "bind_cont m f = ContT (\<lambda>k. run_cont m (\<lambda>x. run_cont (f x) k))"
 
 lemma run_return_cont [simp]: "run_cont (return_cont x) k = k x"
 by(simp add: return_cont_def)
 
 lemma run_bind_cont [simp]: "run_cont (bind_cont m f) k = run_cont m (\<lambda>x. run_cont (f x) k)"
 by(simp add: bind_cont_def)
 
 lemma monad_contT [locale_witness]: "monad return_cont bind_cont" (is "monad ?return ?bind")
 proof
   show "?bind (?bind x f) g = ?bind x (\<lambda>x. ?bind (f x) g)" for x f g
     by(rule contT.expand)(simp add: fun_eq_iff)
   show "?bind (?return x) f = f x" for f x
     by(rule contT.expand)(simp add: fun_eq_iff)
   show "?bind x ?return = x" for x
     by(rule contT.expand)(simp add: fun_eq_iff)
 qed
 
 subsubsection \<open>Failure\<close>
 
 context
   fixes fail :: "'m fail"
 begin
 
 definition fail_cont :: "('a, 'm) contT fail"
 where "fail_cont = ContT (\<lambda>_. fail)"
 
 lemma run_fail_cont [simp]: "run_cont fail_cont k = fail"
 by(simp add: fail_cont_def)
 
 lemma monad_fail_contT [locale_witness]: "monad_fail return_cont bind_cont fail_cont"
 proof
   show "bind_cont fail_cont f = fail_cont" for f :: "'a \<Rightarrow> ('a, 'm) contT"
     by(rule contT.expand)(simp add: fun_eq_iff)
 qed
 
 end
 
 subsubsection \<open>State\<close>
 
 context
   fixes get :: "('s, 'm) get"
   and put :: "('s, 'm) put"
 begin
 
 definition get_cont :: "('s, ('a, 'm) contT) get"
 where "get_cont f = ContT (\<lambda>k. get (\<lambda>s. run_cont (f s) k))"
 
 definition put_cont :: "('s, ('a, 'm) contT) put"
 where "put_cont s m = ContT (\<lambda>k. put s (run_cont m k))"
 
 lemma run_get_cont [simp]: "run_cont (get_cont f) k = get (\<lambda>s. run_cont (f s) k)"
 by(simp add: get_cont_def)
 
 lemma run_put_cont [simp]: "run_cont (put_cont s m) k = put s (run_cont m k)"
 by(simp add: put_cont_def)
 
 lemma monad_state_contT [locale_witness]:
   assumes "monad_state return' bind' get put" \<comment> \<open>We don't need the plain monad operations for lifting.\<close>
   shows "monad_state return_cont bind_cont get_cont (put_cont :: ('s, ('a, 'm) contT) put)"
   (is "monad_state ?return ?bind ?get ?put")
 proof -
   interpret monad_state return' bind' get put by(fact assms)
   show ?thesis
   proof
     show "put_cont s (get_cont f) = put_cont s (f s)" for s :: 's and f :: "'s \<Rightarrow> ('a, 'm) contT"
       by(rule contT.expand)(simp add: put_get fun_eq_iff)
     show "get_cont (\<lambda>s. get_cont (f s)) = get_cont (\<lambda>s. f s s)" for f :: "'s \<Rightarrow> 's \<Rightarrow> ('a, 'm) contT"
       by(rule contT.expand)(simp add: get_get fun_eq_iff)
     show "put_cont s (put_cont s' m) = put_cont s' m" for s s' and m :: "('a, 'm) contT"
       by(rule contT.expand)(simp add: put_put fun_eq_iff)
     show "get_cont (\<lambda>s. put_cont s m) = m" for m :: "('a, 'm) contT"
       by(rule contT.expand)(simp add: get_put fun_eq_iff)
     show "get_cont (\<lambda>_. m) = m" for m :: "('a, 'm) contT"
       by(rule contT.expand)(simp add: get_const fun_eq_iff)
     show "bind_cont (get_cont f) g = get_cont (\<lambda>s. bind_cont (f s) g)"
       for f :: "'s \<Rightarrow> ('a, 'm) contT" and g 
       by(rule contT.expand)(simp add: fun_eq_iff)
     show "bind_cont (put_cont s m) f = put_cont s (bind_cont m f)" for s and m :: "('a, 'm) contT" and f
       by(rule contT.expand)(simp add: fun_eq_iff)
   qed
 qed
 
 end
 
 section \<open>Locales for monad homomorphisms\<close>
 
 locale monad_hom = m1: monad return1 bind1 +
   m2: monad return2 bind2
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_return: "\<And>x. h (return1 x) = return2 x"
   and hom_bind: "\<And>x f. h (bind1 x f) = bind2 (h x) (h \<circ> f)"
 begin
 
 lemma hom_lift [simp]: "h (m1.lift f m) = m2.lift f (h m)"
 by(simp add: m1.lift_def m2.lift_def hom_bind hom_return o_def)
 
 end
 
 locale monad_state_hom = m1: monad_state return1 bind1 get1 put1 + 
   m2: monad_state return2 bind2 get2 put2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and get1 :: "('s, 'm1) get"
   and put1 :: "('s, 'm1) put"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and get2 :: "('s, 'm2) get"
   and put2 :: "('s, 'm2) put"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_get [simp]: "h (get1 f) = get2 (h \<circ> f)"
   and hom_put [simp]: "h (put1 s m) = put2 s (h m)"
 
 locale monad_fail_hom = m1: monad_fail return1 bind1 fail1 + 
   m2: monad_fail return2 bind2 fail2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and fail1 :: "'m1 fail"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and fail2 :: "'m2 fail"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_fail [simp]: "h fail1 = fail2"
 
 locale monad_catch_hom = m1: monad_catch return1 bind1 fail1 catch1 +
   m2: monad_catch return2 bind2 fail2 catch2 +
   monad_fail_hom return1 bind1 fail1 return2 bind2 fail2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and fail1 :: "'m1 fail"
   and catch1 :: "'m1 catch"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and fail2 :: "'m2 fail"
   and catch2 :: "'m2 catch"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_catch [simp]: "h (catch1 m1 m2) = catch2 (h m1) (h m2)"
 
 locale monad_reader_hom = m1: monad_reader return1 bind1 ask1 +
   m2: monad_reader return2 bind2 ask2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and ask1 :: "('r, 'm1) ask"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and ask2 :: "('r, 'm2) ask"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_ask [simp]: "h (ask1 f) = ask2 (h \<circ> f)"
 
 locale monad_prob_hom = m1: monad_prob return1 bind1 sample1 +
   m2: monad_prob return2 bind2 sample2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and sample1 :: "('p, 'm1) sample"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and sample2 :: "('p, 'm2) sample"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_sample [simp]: "h (sample1 p f) = sample2 p (h \<circ> f)"
 
 locale monad_alt_hom = m1: monad_alt return1 bind1 alt1 +
   m2: monad_alt return2 bind2 alt2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and alt1 :: "'m1 alt"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and alt2 :: "'m2 alt"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_alt [simp]: "h (alt1 m m') = alt2 (h m) (h m')"
 
 locale monad_altc_hom = m1: monad_altc return1 bind1 altc1 +
   m2: monad_altc return2 bind2 altc2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and altc1 :: "('c, 'm1) altc"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and altc2 :: "('c, 'm2) altc"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_altc [simp]: "h (altc1 C f) = altc2 C (h \<circ> f)"
 
 locale monad_writer_hom = m1: monad_writer return1 bind1 tell1 +
   m2: monad_writer return2 bind2 tell2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and tell1 :: "('w, 'm1) tell"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and tell2 :: "('w, 'm2) tell"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_tell [simp]: "h (tell1 w m) = tell2 w (h m)"
 
 locale monad_resumption_hom = m1: monad_resumption return1 bind1 pause1 +
   m2: monad_resumption return2 bind2 pause2 +
   monad_hom return1 bind1 return2 bind2 h
   for return1 :: "('a, 'm1) return"
   and bind1 :: "('a, 'm1) bind"
   and pause1 :: "('o, 'i, 'm1) pause"
   and return2 :: "('a, 'm2) return"
   and bind2 :: "('a, 'm2) bind"
   and pause2 :: "('o, 'i, 'm2) pause"
   and h :: "'m1 \<Rightarrow> 'm2"
   +
   assumes hom_pause [simp]: "h (pause1 out c) = pause2 out (h \<circ> c)"
 
 section \<open>Switching between monads\<close>
 
 text \<open>Homomorphisms are functional relations between monads. In general, it is more
   convenient to use arbitrary relations as embeddings because arbitrary relations allow us to
   change the type of values in a monad. As different monad transformers change the value type in 
   different ways, the embeddings must also support such changes in values. \<close>
 
 context includes lifting_syntax begin
 
 subsection \<open>Embedding Identity into Probability\<close>
 
 named_theorems cr_id_prob_transfer
 
 definition prob_of_id :: "'a id \<Rightarrow> 'a prob" where
   "prob_of_id m = return_pmf (extract m)"
 
 lemma monad_id_prob_hom [locale_witness]:
   "monad_hom return_id bind_id return_pmf bind_pmf prob_of_id"
 proof
   show "prob_of_id (return_id x) = return_pmf x" for x :: 'a
     by(simp add: prob_of_id_def)
   show "prob_of_id (bind_id x f) = prob_of_id x \<bind> prob_of_id \<circ> f" for x :: "'a id" and f
     by(simp add: prob_of_id_def bind_return_pmf)
 qed
 
 
 inductive cr_id_prob :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a id \<Rightarrow> 'b prob \<Rightarrow> bool" for A
 where "A x y \<Longrightarrow> cr_id_prob A (return_id x) (return_pmf y)"
 
 inductive_simps cr_id_prob_simps [simp]: "cr_id_prob A (return_id x) (return_pmf y)"
 
 lemma cr_id_prob_return [cr_id_prob_transfer]: "(A ===> cr_id_prob A) return_id return_pmf"
 by(simp add: rel_fun_def)
 
 lemma cr_id_prob_bind [cr_id_prob_transfer]: 
   "(cr_id_prob A ===> (A ===> cr_id_prob B) ===> cr_id_prob B) bind_id bind_pmf"
 by(auto simp add: rel_fun_def bind_return_pmf elim!: cr_id_prob.cases)
 
 lemma cr_id_prob_Grp: "cr_id_prob (BNF_Def.Grp A f) = BNF_Def.Grp {x. set_id x \<subseteq> A} (return_pmf \<circ> f \<circ> extract)"
 apply(auto simp add: Grp_def fun_eq_iff simp add: cr_id_prob.simps intro: id.expand)
 subgoal for x by(cases x) auto
 done
 
 subsection \<open>State and Reader\<close>
 
 text \<open>When no state updates are needed, the operation @{term get} can be replaced by @{term ask}.\<close>
 
 named_theorems cr_envT_stateT_transfer
 
 definition cr_prod1 :: "'c \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'c \<Rightarrow> bool"
 where "cr_prod1 c' A = (\<lambda>a (b, c). A a b \<and> c' = c)"
 
 lemma cr_prod1_simps [simp]: "cr_prod1 c' A a (b, c) \<longleftrightarrow> A a b \<and> c' = c"
 by(simp add: cr_prod1_def)
 
 lemma cr_prod1I: "A a b \<Longrightarrow> cr_prod1 c' A a (b, c')" by simp
 
 lemma cr_prod1_Pair_transfer [cr_envT_stateT_transfer]: "(A ===> eq_onp ((=) c) ===> cr_prod1 c A) (\<lambda>a _. a) Pair"
 by(auto simp add: rel_fun_def eq_onp_def)
 
 lemma cr_prod1_fst_transfer [cr_envT_stateT_transfer]: "(cr_prod1 c A ===> A) (\<lambda>a. a) fst"
 by(auto simp add: rel_fun_def)
 
 lemma cr_prod1_case_prod_transfer [cr_envT_stateT_transfer]:
   "((A ===> eq_onp ((=) c) ===> C) ===> cr_prod1 c A ===> C) (\<lambda>f a. f a c) case_prod"
 by(simp add: rel_fun_def eq_onp_def)
 
 lemma cr_prod1_Grp: "cr_prod1 c (BNF_Def.Grp A f) = BNF_Def.Grp A (\<lambda>b. (f b, c))"
 by(auto simp add: Grp_def fun_eq_iff)
 
 
 definition cr_envT_stateT :: "'s \<Rightarrow> ('m1 \<Rightarrow> 'm2 \<Rightarrow> bool) \<Rightarrow> ('s, 'm1) envT \<Rightarrow> ('s, 'm2) stateT \<Rightarrow> bool"
 where "cr_envT_stateT s M m1 m2 = (eq_onp ((=) s) ===> M) (run_env m1) (run_state m2)"
 
 lemma cr_envT_stateT_simps [simp]:
   "cr_envT_stateT s M (EnvT f) (StateT g) \<longleftrightarrow> M (f s) (g s)"
 by(simp add: cr_envT_stateT_def rel_fun_def eq_onp_def)
 
 lemma cr_envT_stateTE:
   assumes "cr_envT_stateT s M m1 m2"
   obtains f g where "m1 = EnvT f" "m2 = StateT g" "(eq_onp ((=) s) ===> M) f g"
 using assms by(cases m1; cases m2; auto simp add: eq_onp_def)
 
 lemma cr_envT_stateTD: "cr_envT_stateT s M m1 m2 \<Longrightarrow> M (run_env m1 s) (run_state m2 s)"
 by(auto elim!: cr_envT_stateTE dest: rel_funD simp add: eq_onp_def)
 
 lemma cr_envT_stateT_run [cr_envT_stateT_transfer]:
   "(cr_envT_stateT s M ===> eq_onp ((=) s) ===> M) run_env run_state"
 by(rule rel_funI)(auto elim!: cr_envT_stateTE)
 
 lemma cr_envT_stateT_StateT_EnvT [cr_envT_stateT_transfer]:
   "((eq_onp ((=) s) ===> M) ===> cr_envT_stateT s M) EnvT StateT"
 by(auto 4 3 dest: rel_funD simp add: eq_onp_def)
 
 lemma cr_envT_stateT_rec [cr_envT_stateT_transfer]:
   "(((eq_onp ((=) s) ===> M) ===> C) ===> cr_envT_stateT s M ===> C) rec_envT rec_stateT"
 by(auto simp add: rel_fun_def elim!: cr_envT_stateTE)
 
 lemma cr_envT_stateT_return [cr_envT_stateT_transfer]:
   notes [transfer_rule] = cr_envT_stateT_transfer shows
   "((cr_prod1 s A ===> M) ===> A ===> cr_envT_stateT s M) return_env return_state"
 unfolding return_env_def return_state_def by transfer_prover
 
 lemma cr_envT_stateT_bind [cr_envT_stateT_transfer]:
   "((M ===> (cr_prod1 s A ===> M) ===> M) ===> cr_envT_stateT s M ===> (A ===> cr_envT_stateT s M) ===> cr_envT_stateT s M)
    bind_env bind_state"
 apply(rule rel_funI)+
 apply(erule cr_envT_stateTE)
 apply(clarsimp simp add: split_def)
 apply(drule rel_funD)
  apply(erule rel_funD)
  apply(simp add: eq_onp_def)
 apply(erule rel_funD)
 apply(rule rel_funI)
 apply clarsimp
 apply(rule cr_envT_stateT_run[THEN rel_funD, THEN rel_funD, where B=M])
 apply(erule (1) rel_funD)
 apply(simp add: eq_onp_def)
 done
 
 lemma cr_envT_stateT_ask_get [cr_envT_stateT_transfer]:
   "((eq_onp ((=) s) ===> cr_envT_stateT s M) ===> cr_envT_stateT s M) ask_env get_state"
 unfolding ask_env_def get_state_def
 apply(rule rel_funI)+
 apply simp
 apply(rule cr_envT_stateT_run[THEN rel_funD, THEN rel_funD])
  apply(erule rel_funD)
  apply(simp_all add: eq_onp_def)
 done
 
 lemma cr_envT_stateT_fail [cr_envT_stateT_transfer]:
   notes [transfer_rule] = cr_envT_stateT_transfer shows
   "(M ===> cr_envT_stateT s M) fail_env fail_state"
 unfolding fail_env_def fail_state_def by transfer_prover
 
 subsection \<open>@{typ "_ spmf"} and @{typ "(_, _ prob) optionT"}\<close>
 
 text \<open>
   This section defines the mapping between the @{typ "_ spmf"} monad and the monad obtained by
   composing transforming @{typ "_ prob"} with @{typ "(_, _) optionT"}.
 \<close>
 
 definition cr_spmf_prob_optionT :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a, 'a option prob) optionT \<Rightarrow> 'b spmf \<Rightarrow> bool"
 where "cr_spmf_prob_optionT A p q \<longleftrightarrow> rel_spmf A (run_option p) q"
 
 lemma cr_spmf_prob_optionTI: "rel_spmf A (run_option p) q \<Longrightarrow> cr_spmf_prob_optionT A p q"
 by(simp add: cr_spmf_prob_optionT_def)
 
 lemma cr_spmf_prob_optionTD: "cr_spmf_prob_optionT A p q \<Longrightarrow> rel_spmf A (run_option p) q"
 by(simp add: cr_spmf_prob_optionT_def)
 
 lemma cr_spmf_prob_optionT_return_transfer:
    \<comment> \<open>Cannot be used as a transfer rule in @{method transfer_prover} because @{term return_spmf} is not a constant.\<close>
   "(A ===> cr_spmf_prob_optionT A) (return_option return_pmf) return_spmf"
 by(simp add: rel_fun_def cr_spmf_prob_optionTI)
 
 lemma cr_spmf_prob_optionT_bind_transfer:
   "(cr_spmf_prob_optionT A ===> (A ===> cr_spmf_prob_optionT A) ===> cr_spmf_prob_optionT A)
    (bind_option return_pmf bind_pmf) bind_spmf"
 by(rule rel_funI cr_spmf_prob_optionTI)+
   (auto 4 4 simp add: run_bind_option bind_spmf_def dest!: cr_spmf_prob_optionTD dest: rel_funD intro: rel_pmf_bindI split: option.split)
 
 lemma cr_spmf_prob_optionT_fail_transfer:
   "cr_spmf_prob_optionT A (fail_option return_pmf) (return_pmf None)"
 by(rule cr_spmf_prob_optionTI) simp
 
 abbreviation (input) spmf_of_prob_optionT :: "('a, 'a option prob) optionT \<Rightarrow> 'a spmf" 
 where "spmf_of_prob_optionT \<equiv> run_option"
 
 abbreviation (input) prob_optionT_of_spmf :: "'a spmf \<Rightarrow> ('a, 'a option prob) optionT"
 where "prob_optionT_of_spmf \<equiv> OptionT"
 
 lemma spmf_of_prob_optionT_transfer: "(cr_spmf_prob_optionT A ===> rel_spmf A) spmf_of_prob_optionT (\<lambda>x. x)"
 by(auto simp add: rel_fun_def dest: cr_spmf_prob_optionTD)
 
 lemma prob_optionT_of_spmf_transfer: "(rel_spmf A ===> cr_spmf_prob_optionT A) prob_optionT_of_spmf (\<lambda>x. x)"
 by(auto simp add: rel_fun_def intro: cr_spmf_prob_optionTI)
 
 subsection \<open>Probabilities and countable non-determinism\<close>
 
 named_theorems cr_prob_ndi_transfer
 
 context includes cset.lifting begin
 
 interpretation cset_nondetM return_id bind_id merge_id merge_id ..
 
 lift_definition cset_pmf :: "'a pmf \<Rightarrow> 'a cset" is set_pmf by simp
 
 inductive cr_pmf_cset :: "'a pmf \<Rightarrow> 'a cset \<Rightarrow> bool" for p where
   "cr_pmf_cset p (cset_pmf p)"
 
 lemma cr_pmf_cset_Grp: "cr_pmf_cset = BNF_Def.Grp UNIV cset_pmf"
   by(simp add: fun_eq_iff cr_pmf_cset.simps Grp_def)
 
 lemma cr_pmf_cset_return_pmf [cr_prob_ndi_transfer]:
   "((=) ===> cr_pmf_cset) return_pmf csingle"
   by(simp add: cr_pmf_cset.simps rel_fun_def)(transfer; simp)
 
 inductive cr_prob_ndi :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a prob \<Rightarrow> ('b, 'b cset id) nondetT \<Rightarrow> bool" 
   for A p B where
   "cr_prob_ndi A p B" if "rel_set A (set_pmf p) (rcset (extract (run_nondet B)))"
 
 lemma cr_prob_ndi_Grp: "cr_prob_ndi (BNF_Def.Grp UNIV f) = BNF_Def.Grp UNIV (NondetT \<circ> return_id \<circ> cimage f \<circ> cset_pmf)"
   by(simp add: fun_eq_iff cr_prob_ndi.simps rel_set_Grp)
     (auto simp add: Grp_def cimage.rep_eq cset_pmf.rep_eq cin.rep_eq intro!: nondetT.expand id.expand)
 
 lemma cr_ndi_prob_return [cr_prob_ndi_transfer]:
   "(A ===> cr_prob_ndi A) return_pmf return_nondet"
   by(simp add: rel_fun_def cr_prob_ndi.simps)(transfer; simp add: rel_set_def)
 
 lemma cr_ndi_prob_bind [cr_prob_ndi_transfer]:
   "(cr_prob_ndi A ===> (A ===> cr_prob_ndi A) ===> cr_prob_ndi A) bind_pmf bind_nondet"
   apply (clarsimp simp add: cr_prob_ndi.simps cUnion.rep_eq cimage.rep_eq intro!: rel_funI)
   apply(rule Union_transfer[THEN rel_funD])
   apply(rule image_transfer[THEN rel_funD, THEN rel_funD])
    apply(rule rel_funI)
    apply(drule (1) rel_funD)
    apply(erule cr_prob_ndi.cases)
    apply assumption+
   done
 
 lemma cr_ndi_prob_sample [cr_prob_ndi_transfer]:
   "(cr_pmf_cset ===> ((=) ===> cr_prob_ndi A) ===> cr_prob_ndi A) bind_pmf altc_nondet"
   apply(clarsimp intro!: rel_funI simp add: cr_pmf_cset.simps cr_prob_ndi.simps cUnion.rep_eq cimage.rep_eq cset_pmf.rep_eq)
   apply(rule Union_transfer[THEN rel_funD])
   apply(rule image_transfer[THEN rel_funD, THEN rel_funD])                                  
    apply(rule rel_funI)
    apply(drule (1) rel_funD)
    apply(erule cr_prob_ndi.cases)
    apply assumption
   apply(simp add: rel_set_eq)
   done
 
 end
 
 end
 
 end
diff --git a/thys/Regular_Tree_Relations/RR2_Infinite.thy b/thys/Regular_Tree_Relations/RR2_Infinite.thy
--- a/thys/Regular_Tree_Relations/RR2_Infinite.thy
+++ b/thys/Regular_Tree_Relations/RR2_Infinite.thy
@@ -1,515 +1,516 @@
 theory RR2_Infinite
   imports RRn_Automata Tree_Automata_Pumping
 begin
 
 
 lemma map_ta_rule_id [simp]: "map_ta_rule f id r = (r_root r) (map f (r_lhs_states r)) \<rightarrow> (f (r_rhs r))" for f r
   by (simp add: ta_rule.expand ta_rule.map_sel(1 - 3))
 
 (* Finitness/Infinitness facts *)
 
 lemma no_upper_bound_infinite:
   assumes "\<forall>(n::nat). \<exists>t \<in> S. n < f t"
   shows "infinite S"
 proof (rule ccontr, simp)
   assume "finite S"
   then obtain n where "n = Max (f ` S)" "\<forall> t \<in> S. f t \<le> n" by auto
   then show False using assms linorder_not_le by blast
 qed
 
 lemma set_constr_finite:
   assumes "finite F"
   shows "finite {h x | x. x \<in> F \<and> P x}" using assms
   by (induct) auto
 
 lemma bounded_depth_finite:
   assumes fin_F: "finite \<F>" and "\<Union> (funas_term ` S) \<subseteq> \<F>"
     and "\<forall>t \<in> S. depth t \<le> n" and "\<forall>t \<in> S. ground t"
   shows "finite S" using assms(2-)
 proof (induction n arbitrary: S)
   case 0
   {fix t assume elem: "t \<in> S"
     from 0 have "depth t = 0" "ground t" "funas_term t \<subseteq> \<F>" using elem by auto
     then have "\<exists> f. (f, 0) \<in> \<F> \<and> t = Fun f []" by (cases t rule: depth.cases) auto}
   then have "S \<subseteq> {Fun f [] |f . (f, 0) \<in> \<F>}" by (auto simp add: image_iff)
   from finite_subset[OF this] show ?case
     using set_constr_finite[OF fin_F, of "\<lambda> (f, n). Fun f []" "\<lambda> x. snd x = 0"]
     by auto
 next
   case (Suc n)
   from Suc obtain S' where
     S: "S' = {t :: ('a, 'b) term . ground t \<and> funas_term t \<subseteq> \<F> \<and> depth t \<le> n}" "finite S'"
     by (auto simp add: SUP_le_iff)
   then obtain L F where L: "set L = S'" "set F = \<F>" using fin_F by (meson finite_list)
   let ?Sn = "{Fun f ts | f ts. (f, length ts) \<in> \<F> \<and> set ts \<subseteq> S'}"
   let ?Ln = "concat (map (\<lambda> (f, n). map (\<lambda> ts. Fun f ts) (List.n_lists n L)) F)"
   {fix t assume elem: "t \<in> S"
     from Suc have "depth t \<le> Suc n" "ground t" "funas_term t \<subseteq> \<F>" using elem by auto
     then have "funas_term t \<subseteq> \<F> \<and> (\<forall> x \<in> set (args t). depth x \<le> n) \<and> ground t"
       by (cases t rule: depth.cases) auto
     then have "t \<in> ?Sn \<union> S'"
       using S by (cases t) auto} note sub = this
   {fix t assume elem: "t \<in> ?Sn"
     then obtain f ts where [simp]: "t = Fun f ts" and invar: "(f, length ts) \<in> \<F>" "set ts \<subseteq> S'"
       by blast
     then have "Fun f ts \<in> set (map (\<lambda> ts. Fun f ts) (List.n_lists (length ts) L))" using L(1)
       by (auto simp: image_iff set_n_lists)
     then have "t \<in> set ?Ln" using invar(1) L(2) by auto}
   from this sub have sub: "?Sn \<subseteq> set ?Ln" "S \<subseteq> ?Sn \<union> S'" by blast+
   from finite_subset[OF sub(1)] finite_subset[OF sub(2)] finite_UnI[of ?Sn, OF _ S(2)]
   show ?case by blast
 qed
 
 lemma infinite_imageD:
   "infinite (f ` S) \<Longrightarrow> inj_on f S \<Longrightarrow> infinite S"
   by blast
 
 lemma infinite_imageD2:
   "infinite (f ` S) \<Longrightarrow> inj f \<Longrightarrow> infinite S"
   by blast
 
 lemma infinite_inj_image_infinite:
   assumes "infinite S" and "inj_on f S"
   shows "infinite (f ` S)"
   using assms finite_image_iff by blast
 
 (*The following lemma tells us that number of terms greater than a certain depth are infinite*)
 lemma infinte_no_depth_limit:
   assumes "infinite S" and "finite \<F>"
     and "\<forall>t \<in> S. funas_term t \<subseteq> \<F>" and "\<forall>t \<in> S. ground t"
   shows "\<forall>(n::nat). \<exists>t \<in> S. n < (depth t)"
 proof(rule allI, rule ccontr)
   fix n::nat
   assume "\<not> (\<exists>t \<in> S. (depth t) >  n)"
   hence "\<forall>t \<in> S. depth t \<le> n" by auto
   from bounded_depth_finite[OF assms(2) _ this] show False using assms
     by auto
 qed
 
 lemma depth_gterm_conv:
   "depth (term_of_gterm t) = depth (term_of_gterm t)"
   by (metis leD nat_neq_iff poss_gposs_conv poss_length_bounded_by_depth poss_length_depth)
 
 lemma funs_term_ctxt [simp]:
   "funs_term C\<langle>s\<rangle> = funs_ctxt C \<union> funs_term s"
   by (induct C) auto
 
 lemma pigeonhole_ta_infinit_terms:
   fixes t ::"'f gterm" and \<A> :: "('q, 'f) ta"
   defines "t' \<equiv> term_of_gterm t :: ('f, 'q) term"
   assumes "fcard (\<Q> \<A>) < depth t'" and "q |\<in>| gta_der \<A> t" and "P (funas_gterm t)"
   shows "infinite {t . q |\<in>| gta_der \<A> t \<and> P (funas_gterm t)}"
 proof -
   from pigeonhole_tree_automata[OF _ assms(3)[unfolded gta_der_def]] assms(2,4)
   obtain C C2 s v p where ctxt: "C2 \<noteq> \<box>" "C\<langle>s\<rangle> = t'" "C2\<langle>v\<rangle> = s" and
     loop: "p |\<in>| ta_der \<A> v" "p |\<in>| ta_der \<A> C2\<langle>Var p\<rangle>" "q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>"
     unfolding assms(1) by auto
   let ?terms = "\<lambda> n. C\<langle>(C2 ^n)\<langle>v\<rangle>\<rangle>" let ?inner = "\<lambda> n. (C2 ^n)\<langle>v\<rangle>"
   have gr: "ground_ctxt C2" "ground_ctxt C" "ground v"
     using arg_cong[OF ctxt(2), of ground] unfolding ctxt(3)[symmetric] assms(1)
     by fastforce+
   moreover have funas: "funas_term (?terms (Suc n)) = funas_term t'" for n
     unfolding ctxt(2, 3)[symmetric] using ctxt_comp_n_pres_funas by auto
   moreover have der: "q |\<in>| ta_der \<A> (?terms (Suc n))" for n using loop
     by (meson ta_der_ctxt ta_der_ctxt_n_loop)
   moreover have "n < depth (?terms (Suc n))" for n
     by (meson ctxt(1) ctxt_comp_n_lower_bound depth_ctxt_less_eq less_le_trans)
   ultimately have "q |\<in>| ta_der \<A> (?terms (Suc n)) \<and> ground (?terms (Suc n)) \<and>
     P (funas_term (?terms (Suc n))) \<and> n < depth (?terms (Suc n))" for n using assms(4)
     by (auto simp: assms(1) funas_term_of_gterm_conv)
   then have inf: "infinite {t. q |\<in>| ta_der \<A> t \<and> ground t \<and> P (funas_term t)}"
     by (intro no_upper_bound_infinite[of _ depth]) blast
   have inj: "inj_on gterm_of_term {t. q |\<in>| ta_der \<A> t \<and> ground t \<and> P (funas_term t)}"
     by (intro gterm_of_term_inj) simp
   show ?thesis
     by (intro infinite_super[OF _ infinite_inj_image_infinite[OF inf inj]])
        (auto simp: image_def gta_der_def funas_gterm_gterm_of_term)
 qed
 
 
 lemma gterm_to_None_Some_funas [simp]:
   "funas_gterm (gterm_to_None_Some t) \<subseteq> (\<lambda> (f, n). ((None, Some f), n)) ` \<F> \<longleftrightarrow> funas_gterm t \<subseteq> \<F>"
   by (induct t) (auto simp: funas_gterm_def, blast)
 
 lemma funas_gterm_bot_some_decomp:
   assumes "funas_gterm s \<subseteq> (\<lambda> (f, n). ((None, Some f), n)) ` \<F>"
   shows "\<exists> t. gterm_to_None_Some t = s \<and> funas_gterm t \<subseteq> \<F>" using assms
 proof (induct s)
   case (GFun f ts)
   from GFun(1)[OF nth_mem] obtain ss where l: "length ss = length ts \<and> (\<forall>i<length ts. gterm_to_None_Some (ss ! i) = ts ! i)"
     using Ex_list_of_length_P[of "length ts" "\<lambda> s i. gterm_to_None_Some s = ts ! i"] GFun(2-)
     by (auto simp: funas_gterm_def) (meson UN_subset_iff nth_mem)
   then have "i < length ss \<Longrightarrow> funas_gterm (ss ! i) \<subseteq> \<F>" for i using GFun(2)
     by (auto simp: UN_subset_iff) (smt (z3) gterm_to_None_Some_funas nth_mem subsetD)
   then show ?case using GFun(2-) l
     by (cases f) (force simp: map_nth_eq_conv UN_subset_iff dest!: in_set_idx intro!: exI[of _ "GFun (the (snd f)) ss"])
 qed
 
 (* Definition INF, Q_infinity and automata construction *)
 
 definition "Inf_branching_terms \<R> \<F> = {t . infinite {u. (t, u) \<in> \<R> \<and> funas_gterm u \<subseteq> fset \<F>} \<and> funas_gterm t \<subseteq> fset \<F>}"
 
 definition "Q_infty \<A> \<F> = {|q | q. infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}|}"
 
 lemma Q_infty_fmember:
   "q |\<in>| Q_infty \<A> \<F> \<longleftrightarrow> infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}"
 proof -
   have "{q | q. infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}} \<subseteq> fset (\<Q> \<A>)"
     using not_finite_existsD by fastforce
   from finite_subset[OF this] show ?thesis
     by (auto simp: Q_infty_def)
 qed
 
 abbreviation q_inf_dash_intro_rules where
   "q_inf_dash_intro_rules Q r \<equiv> if (r_rhs r) |\<in>| Q \<and> fst (r_root r) = None then {|(r_root r) (map CInl (r_lhs_states r)) \<rightarrow> CInr (r_rhs r)|} else {||}"
 
 abbreviation args :: "'a list \<Rightarrow> nat \<Rightarrow> ('a + 'a) list" where
   "args \<equiv> \<lambda> qs i. map CInl (take i qs) @ CInr (qs ! i) # map CInl (drop (Suc i) qs)"
 
 abbreviation q_inf_dash_closure_rules :: "('q, 'f) ta_rule \<Rightarrow> ('q + 'q, 'f) ta_rule list" where
   "q_inf_dash_closure_rules r \<equiv> (let (f, qs, q) = (r_root r, r_lhs_states r, r_rhs r) in
    (map (\<lambda> i. f (args qs i) \<rightarrow> CInr q) [0 ..< length qs]))"
 
 definition Inf_automata :: "('q, 'f option \<times> 'f option) ta \<Rightarrow> 'q fset \<Rightarrow> ('q + 'q, 'f option \<times> 'f option) ta" where
   "Inf_automata \<A> Q = TA
   (( |\<Union>| (q_inf_dash_intro_rules Q |`| rules \<A>)) |\<union>| ( |\<Union>| ((fset_of_list \<circ> q_inf_dash_closure_rules) |`| rules \<A>)) |\<union>|
    map_ta_rule CInl id |`| rules \<A>) (map_both Inl |`| eps \<A> |\<union>| map_both CInr |`| eps \<A>)"
 
 definition Inf_reg where
   "Inf_reg \<A> Q = Reg (CInr |`| fin \<A>) (Inf_automata (ta \<A>) Q)"
 
 lemma Inr_Inl_rel_comp:
   "map_both CInr |`| S |O| map_both CInl |`| S = {||}" by auto
 
 lemmas eps_split = ftrancl_Un2_separatorE[OF Inr_Inl_rel_comp]
 
 lemma Inf_automata_eps_simp [simp]:
   shows "(map_both Inl |`| eps \<A> |\<union>| map_both CInr |`| eps \<A>)|\<^sup>+| =
       (map_both CInl |`| eps \<A>)|\<^sup>+| |\<union>| (map_both CInr |`| eps \<A>)|\<^sup>+|"
 proof -
   {fix x y z assume "(x, y) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+|"
     "(y, z) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+|"
     then have False
       by (metis Inl_Inr_False eps_statesI(1, 2) eps_states_image fimageE ftranclD ftranclD2)}
   then show ?thesis by (auto simp: Inf_automata_def eps_split)
 qed
 
 lemma map_both_CInl_ftrancl_conv:
   "(map_both CInl |`| eps \<A>)|\<^sup>+| = map_both CInl |`| (eps \<A>)|\<^sup>+|"
   by (intro ftrancl_map_both_fsubset) (auto simp: finj_CInl_CInr)
 
 lemma map_both_CInr_ftrancl_conv:
   "(map_both CInr |`| eps \<A>)|\<^sup>+| = map_both CInr |`| (eps \<A>)|\<^sup>+|"
   by (intro ftrancl_map_both_fsubset) (auto simp: finj_CInl_CInr)
 
 lemmas map_both_ftrancl_conv = map_both_CInl_ftrancl_conv map_both_CInr_ftrancl_conv 
 
 lemma Inf_automata_Inl_to_eps [simp]:
   "(CInl p, CInl q) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+|"
   "(CInr p, CInr q) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+|"
   "(CInl q, CInl p) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> False"
   "(CInr q, CInr p) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> False"
   by (auto simp: map_both_ftrancl_conv dest: fmap_prod_fimageI)
 
 lemma Inl_eps_Inr:
   "(CInl q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> (CInr q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|"
   by (auto simp: Inf_automata_def)
 
 lemma Inr_rhs_eps_Inr_lhs:
   assumes "(q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|"
   obtains q' where "q = CInr q'" using assms ftrancl_map_both_fsubset[OF finj_CInl_CInr(1)]
   by (cases q) (auto simp: Inf_automata_def map_both_ftrancl_conv)
 
 lemma Inl_rhs_eps_Inl_lhs:
   assumes "(q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|"
   obtains q' where "q = CInl q'" using assms
   by (cases q) (auto simp: Inf_automata_def map_both_ftrancl_conv)
 
 lemma Inf_automata_eps [simp]:
   "(CInl q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> False"
   "(CInr q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> False"
   by (auto elim: Inr_rhs_eps_Inr_lhs Inl_rhs_eps_Inl_lhs)
 
 lemma Inl_A_res_Inf_automata:
   "ta_der (fmap_states_ta CInl \<A>) t |\<subseteq>| ta_der (Inf_automata \<A> Q) t"
 proof (rule ta_der_mono)
   show "rules (fmap_states_ta CInl \<A>) |\<subseteq>| rules (Inf_automata \<A> Q)"
     apply (rule fsubsetI)
-    apply (simp add: Inf_automata_def fmap_states_ta_def')
-    by force
+    by (auto simp: Inf_automata_def fmap_states_ta_def' image_iff Bex_def)
 next
   show "eps (fmap_states_ta CInl \<A>) |\<subseteq>| eps (Inf_automata \<A> Q)"
     by (rule fsubsetI) (simp add: Inf_automata_def fmap_states_ta_def')
 qed
 
 lemma Inl_res_A_res_Inf_automata:
   "CInl |`| ta_der \<A> (term_of_gterm t) |\<subseteq>| ta_der (Inf_automata \<A> Q) (term_of_gterm t)"
   by (intro fsubset_trans[OF ta_der_fmap_states_ta_mono[of CInl \<A> t]]) (auto simp: Inl_A_res_Inf_automata)
 
 lemma r_rhs_CInl_args_A_rule:
   assumes "f qs \<rightarrow> CInl q |\<in>| rules (Inf_automata \<A> Q)"
   obtains qs' where "qs = map CInl qs'" "f qs' \<rightarrow> q |\<in>| rules \<A>" using assms
   by (auto simp: Inf_automata_def split!: if_splits)
 
 lemma A_rule_to_dash_closure:
   assumes "f qs \<rightarrow> q |\<in>| rules \<A>" and "i < length qs"
   shows "f (args qs i) \<rightarrow> CInr q |\<in>| rules (Inf_automata \<A> Q)"
   using assms by (auto simp add: Inf_automata_def fimage_iff fBall_def upt_fset intro!: fBexI[OF _ assms(1)])
 
 lemma Inf_automata_reach_to_dash_reach:
   assumes "CInl p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInl q)\<rangle>"
   shows "CInr p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q)\<rangle>" (is "_ |\<in>| ta_der ?A _")
   using assms
 proof (induct C arbitrary: p)
   case (More f ss C ts)
   from More(2) obtain qs q' where
     rule: "f qs \<rightarrow> q' |\<in>| rules ?A" "length qs = Suc (length ss + length ts)" and
     eps: "q' = CInl p \<or> (q', CInl p) |\<in>| (eps ?A)|\<^sup>+|" and
     reach: "\<forall> i <  Suc (length ss + length ts). qs ! i |\<in>| ta_der ?A ((ss @ C\<langle>Var (CInl q)\<rangle> # ts) ! i)"
     by auto
   from eps obtain q'' where [simp]: "q' = CInl q''"
     by (cases q') (auto simp add: Inf_automata_def eps_split elim: ftranclE converse_ftranclE)
   from rule obtain qs' where args: "qs = map CInl qs'" "f qs' \<rightarrow> q'' |\<in>| rules \<A>"
     using r_rhs_CInl_args_A_rule by (metis \<open>q' = CInl q''\<close>)
   then have "CInl (qs' ! length ss) |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInl q)\<rangle>" using reach
     by (auto simp: all_Suc_conv nth_append_Cons) (metis length_map less_add_Suc1 local.rule(2) nth_append_length nth_map reach) 
   from More(1)[OF this] More(2) show ?case
     using rule args eps reach A_rule_to_dash_closure[OF args(2), of "length ss" Q]
     by (auto simp: Inl_eps_Inr id_take_nth_drop all_Suc_conv
         intro!: exI[of _ "CInr q''"] exI[of _ "map CInl (take (length ss) qs') @ CInr (qs' ! length ss) # map CInl (drop (Suc (length ss)) qs')"])
       (auto simp: nth_append_Cons min_def)
 qed (auto simp: Inf_automata_def)
 
 lemma Inf_automata_dashI:
   assumes "run \<A> r (gterm_to_None_Some t)" and "ex_rule_state r |\<in>| Q"
   shows "CInr (ex_rule_state r) |\<in>| gta_der (Inf_automata \<A> Q) (gterm_to_None_Some t)"
 proof (cases t)
   case [simp]: (GFun f ts)
   from run_root_rule[OF assms(1)] run_argsD[OF assms(1)] have
     rule: "TA_rule (None, Some f) (map ex_comp_state (gargs r)) (ex_rule_state r) |\<in>| rules \<A>" "length (gargs r) = length ts" and
     reach: "\<forall> i < length ts. ex_comp_state (gargs r ! i) |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some (ts  ! i)))"
     by (auto intro!: run_to_comp_st_gta_der[unfolded gta_der_def comp_def])
   from rule assms(2) have "(None, Some f) (map (CInl \<circ> ex_comp_state) (gargs r)) \<rightarrow> CInr (ex_rule_state r) |\<in>| rules  (Inf_automata \<A> Q)"
-    by (auto simp: Inf_automata_def) force
+    apply (simp add: Inf_automata_def image_iff bex_Un)
+    apply (rule disjI1)
+    by force
   then show ?thesis using reach rule Inl_res_A_res_Inf_automata[of \<A> "gterm_to_None_Some (ts ! i)" Q for i]
     by (auto simp: gta_der_def intro!: exI[of _ "CInr (ex_rule_state r)"]  exI[of _ "map (CInl \<circ> ex_comp_state) (gargs r)"])
         blast
 qed
 
 lemma Inf_automata_dash_reach_to_reach:
   assumes "p |\<in>| ta_der (Inf_automata \<A> Q) t" (is "_ |\<in>| ta_der ?A _")
   shows "remove_sum p |\<in>| ta_der \<A> (map_vars_term remove_sum t)" using assms
 proof (induct t arbitrary: p)
   case (Var x) then show ?case
     by (cases p; cases x) (auto simp: Inf_automata_def ftrancl_map_both map_both_ftrancl_conv)
 next
   case (Fun f ss)
   from Fun(2) obtain qs q' where
     rule: "f qs \<rightarrow> q' |\<in>| rules ?A" "length qs = length ss" and
     eps: "q' = p \<or> (q', p) |\<in>| (eps ?A)|\<^sup>+|" and
     reach: "\<forall> i <  length ss. qs ! i |\<in>| ta_der ?A (ss ! i)" by auto
   from rule have r: "f (map (remove_sum) qs) \<rightarrow> (remove_sum q') |\<in>| rules \<A>"
     by (auto simp: comp_def Inf_automata_def min_def id_take_nth_drop[symmetric] upt_fset
              simp flip: drop_map take_map split!: if_splits)
   moreover have "remove_sum q' = remove_sum p \<or> (remove_sum q', remove_sum p) |\<in>| (eps \<A>)|\<^sup>+|" using eps
     by (cases "is_Inl q'"; cases "is_Inl p") (auto elim!: is_InlE is_InrE, auto simp: Inf_automata_def)
   ultimately show ?case using reach rule(2) Fun(1)[OF nth_mem, of i "qs ! i" for i]
     by auto (metis (mono_tags, lifting) length_map map_nth_eq_conv)+
 qed
 
 lemma depth_poss_split:
   assumes "Suc (depth (term_of_gterm t) + n) < depth (term_of_gterm u)"
   shows "\<exists> p q. p @ q \<in> gposs u \<and> n < length q \<and> p \<notin> gposs t"
 proof -
   from poss_length_depth obtain p m where p: "p \<in> gposs u" "length p = m" "depth (term_of_gterm u) = m"
     using poss_gposs_conv by blast
   then obtain m' where dt: "depth (term_of_gterm t) = m'" by blast
   from assms dt p(2, 3) have "length (take (Suc m') p) = Suc m'"
     by (metis Suc_leI depth_gterm_conv length_take less_add_Suc1 less_imp_le_nat less_le_trans min.absorb2)
   then have nt: "take (Suc m') p \<notin> gposs t" using poss_length_bounded_by_depth dt depth_gterm_conv
     by (metis Suc_n_not_le_n gposs_to_poss)
   moreover have "n < length (drop (Suc m') p)" using assms depth_gterm_conv dt p(2-)
     by (metis add_Suc diff_diff_left length_drop zero_less_diff) 
   ultimately show ?thesis by (metis append_take_drop_id p(1))
 qed
 
 lemma Inf_to_automata:
   assumes "RR2_spec \<A> \<R>" and "t \<in> Inf_branching_terms \<R> \<F>"
   shows "\<exists> u. gpair t u \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" (is "\<exists> u. gpair t u \<in> \<L> ?B")
 proof -
   let ?A = "Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)"
   let ?t_of_g = "\<lambda> t. term_of_gterm t :: ('b, 'a) term"
   obtain n where depth_card: "depth (?t_of_g t) + fcard (\<Q> (ta \<A>)) < n" by auto
   from assms(1, 2) have fin: "infinite {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}"
     by (auto simp: RR2_spec_def Inf_branching_terms_def)
   from infinte_no_depth_limit[of "?t_of_g ` {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}" "fset \<F>"] this
   have "\<forall> n. \<exists>t \<in> ?t_of_g ` {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}. n < depth t"
     by (simp add: infinite_inj_image_infinite[OF fin] funas_term_of_gterm_conv inj_term_of_gterm)
   from this depth_card obtain u where funas: "funas_gterm u \<subseteq> fset \<F>" and
     depth: "Suc n < depth (?t_of_g u)" and lang: "gpair t u \<in> \<L> \<A>" by auto
   have "Suc (depth (term_of_gterm t) + fcard (\<Q> (ta \<A>))) < depth (term_of_gterm u)"
     using depth depth_card by (metis Suc_less_eq2 depth_gterm_conv less_trans)
   from depth_poss_split[OF this] obtain p q where
     pos: "p @ q \<in> gposs u" "p \<notin> gposs t" and card: "fcard (\<Q> (ta \<A>)) < length q" by auto
   then have gp: "gsubt_at (gpair t u) p = gterm_to_None_Some (gsubt_at u p)"
     using subst_at_gpair_nt_poss_None_Some[of p] by force
   from lang obtain r where r: "run (ta \<A>) r (gpair t u)" "ex_comp_state r |\<in>| fin \<A>"
     unfolding \<L>_def gta_lang_def by (fastforce dest: gta_der_to_run)
   from pos have p_gtu: "p \<in> gposs (gpair t u)" and pu: "p \<in> gposs u"
     using not_gposs_append by auto
   have qinf: "ex_rule_state (gsubt_at r p) |\<in>| Q_infty (ta \<A>) \<F>"
     using funas_gterm_gsubt_at_subseteq[OF pu] funas card
     unfolding Q_infty_fmember gta_der_def[symmetric]
     by (intro infinite_super[THEN infinite_imageD2[OF _ inj_gterm_to_None_Some],
      OF _ pigeonhole_ta_infinit_terms[of "ta \<A>" "gsubt_at (gpair t u) p" _
      "\<lambda> t. t \<subseteq> (\<lambda>(f, n). ((None, Some f), n)) ` fset \<F>",
      OF _ run_to_gta_der_gsubt_at(1)[OF r(1) p_gtu]]])
         (auto simp: poss_length_bounded_by_depth[of q] image_iff gp less_le_trans
                    pos(1) poss_gposs_conv pu dest!: funas_gterm_bot_some_decomp)
   from Inf_automata_dashI[OF run_gsubt_cl[OF r(1) p_gtu, unfolded gp] qinf]
   have dashI: "CInr (ex_rule_state (gsubt_at r p)) |\<in>| gta_der (Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)) (gsubt_at (gpair t u) p)"
     unfolding gp[symmetric] .
   have "CInl (ex_comp_state r) |\<in>| ta_der ?A (ctxt_at_pos (term_of_gterm (gpair t u)) p)\<langle>Var (CInl (ex_rule_state (gsubt_at r p)))\<rangle>"
     using ta_der_fmap_states_ta[OF run_ta_der_ctxt_split2[OF r(1) p_gtu], of CInl, THEN fsubsetD[OF Inl_A_res_Inf_automata]]
     unfolding replace_term_at_replace_at_conv[OF gposs_to_poss[OF p_gtu]]
     by (auto simp: gterm.map_ident simp flip: map_term_replace_at_dist[OF gposs_to_poss[OF p_gtu]])
   from ta_der_ctxt[OF dashI[unfolded gta_der_def] Inf_automata_reach_to_dash_reach[OF this]]
   have "CInr (ex_comp_state r) |\<in>| gta_der (Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)) (gpair t u)"
     unfolding replace_term_at_replace_at_conv[OF gposs_to_poss[OF p_gtu]]
     unfolding replace_gterm_conv[OF p_gtu]
     by (auto simp: gta_der_def)
   moreover from r(2) have "CInr (ex_comp_state r) |\<in>| fin (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))"
     by (auto simp: Inf_reg_def)
   ultimately show ?thesis using r(2)
     by (auto simp: \<L>_def gta_der_def Inf_reg_def intro: exI[of _ u])
 qed
 
 lemma CInr_Inf_automata_to_q_state:
   assumes "CInr p |\<in>| ta_der (Inf_automata \<A> Q) t" and "ground t"
   shows "\<exists> C s q. C\<langle>s\<rangle> = t \<and> CInr q |\<in>| ta_der (Inf_automata \<A> Q) s \<and> q |\<in>| Q \<and>
     CInr p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q)\<rangle> \<and>
     (fst \<circ> fst \<circ> the \<circ> root) s = None" using assms
 proof (induct t arbitrary: p)
   case (Fun f ts)
   let ?A = "(Inf_automata \<A> Q)"
   from Fun(2) obtain qs q' where
     rule: "f qs \<rightarrow> CInr q' |\<in>| rules ?A" "length qs = length ts" and
     eps: "q' = p \<or> (CInr q', CInr p) |\<in>| (eps ?A)|\<^sup>+|" and
     reach: "\<forall> i < length ts. qs ! i |\<in>| ta_der ?A (ts ! i)"
     by auto (metis Inr_rhs_eps_Inr_lhs)
   consider (a) "\<And> i. i < length qs \<Longrightarrow> \<exists> q''. qs ! i = CInl q''" | (b) "\<exists> i < length qs. \<exists> q''. qs ! i = CInr q''"
     by (meson remove_sum.cases)
   then show ?case
   proof cases
     case a
     then have "f qs \<rightarrow> CInr q' |\<in>| |\<Union>| (q_inf_dash_intro_rules Q |`| rules \<A>)" using rule
       by (auto simp: Inf_automata_def min_def upt_fset split!: if_splits)
          (metis (no_types, lifting) Inl_Inr_False Suc_pred append_eq_append_conv id_take_nth_drop
                length_Cons length_drop length_greater_0_conv length_map
                less_nat_zero_code list.size(3) nth_append_length rule(2))
    then show ?thesis using reach eps rule
      by (intro exI[of _ Hole] exI[of _ "Fun f ts"] exI[of _ q'])
          (auto split!: if_splits)
   next
     case b
     then obtain i q'' where b: "i < length ts" "qs ! i = CInr q''" using rule(2) by auto
     then have "CInr q'' |\<in>| ta_der ?A (ts ! i)" using rule(2) reach by auto 
     from Fun(3) Fun(1)[OF nth_mem, OF b(1) this] b rule(2) obtain C s q''' where
       ctxt: "C\<langle>s\<rangle> = ts ! i" and
       qinf: "CInr q''' |\<in>| ta_der (Inf_automata \<A> Q) s \<and> q''' |\<in>| Q" and
       reach2: "CInr q'' |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q''')\<rangle>" and
       "(fst \<circ> fst \<circ> the \<circ> root) s = None"
       by auto
     then show ?thesis using rule eps reach ctxt qinf reach2 b(1) b(2)[symmetric]
       by (auto simp: min_def nth_append_Cons simp flip: map_append id_take_nth_drop[OF b(1)]
         intro!: exI[of _ "More f (take i ts) C (drop (Suc i) ts)"] exI[of _ "s"] exI[of _ "q'''"] exI[of _ "CInr q'"] exI[of _ "qs"])
   qed
 qed auto
 
 lemma aux_lemma:
   assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)"
     and "infinite {u | u. gpair t u \<in> \<L> \<A>}"
   shows "t \<in> Inf_branching_terms \<R> \<F>"
 proof -
   from assms have [simp]: "gpair t u \<in> \<L> \<A> \<longleftrightarrow> (t, u) \<in> \<R> \<and> u \<in> \<T>\<^sub>G (fset \<F>)"
     for u by (auto simp: RR2_spec_def)
   from assms have "t \<in> \<T>\<^sub>G (fset \<F>)" unfolding RR2_spec_def
     by (auto dest: not_finite_existsD)
   then show ?thesis using assms unfolding Inf_branching_terms_def
     by (auto simp: \<T>\<^sub>G_equivalent_def)
 qed
 
 lemma Inf_automata_to_Inf:
   assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)"
     and "gpair t u \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))"
   shows "t \<in> Inf_branching_terms \<R> \<F>"
 proof -
   let ?con = "\<lambda> t. term_of_gterm (gterm_to_None_Some t)"
   let ?A = "Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)"
   from assms(3) obtain q where fin: "q |\<in>| fin \<A>" and
     reach_fin: "CInr q |\<in>| ta_der ?A (term_of_gterm (gpair t u))"
     by (auto simp: Inf_reg_def \<L>_def Inf_automata_def elim!: gta_langE)
   from CInr_Inf_automata_to_q_state[OF reach_fin] obtain C s p where
     ctxt: "C\<langle>s\<rangle> = term_of_gterm (gpair t u)" and
     q_inf_st: "CInr p |\<in>| ta_der ?A s" "p |\<in>| Q_infty (ta \<A>) \<F>" and
     reach: "CInr q |\<in>| ta_der ?A C\<langle>Var (CInr p)\<rangle>" and
     none: "(fst \<circ> fst \<circ> the \<circ> root) s = None" by auto
   have gr: "ground s" "ground_ctxt C" using arg_cong[OF ctxt, of ground]
     by auto
   have reach: "q |\<in>| ta_der (ta \<A>) (adapt_vars_ctxt C)\<langle>Var p\<rangle>"
     using gr Inf_automata_dash_reach_to_reach[OF reach]
     by (auto simp: map_vars_term_ctxt_apply)
   from q_inf_st(2) have inf: "infinite {v. funas_gterm v \<subseteq> fset \<F> \<and> p |\<in>| ta_der (ta \<A>) (?con v)}"
     by (simp add: Q_infty_fmember)
   have inf: "infinite {v. funas_gterm v \<subseteq> fset \<F> \<and> q |\<in>| gta_der (ta \<A>) (gctxt_of_ctxt C)\<langle>gterm_to_None_Some v\<rangle>\<^sub>G}"
     using reach ground_ctxt_adapt_ground[OF gr(2)] gr
     by (intro infinite_super[OF _ inf], auto simp: gta_der_def)
        (smt (z3) adapt_vars_ctxt adapt_vars_term_of_gterm ground_gctxt_of_ctxt_apply_gterm ta_der_ctxt)
   have *: "gfun_at (gterm_of_term C\<langle>s\<rangle>) (hole_pos C) = gfun_at (gterm_of_term s) []"
     by (induct C) (auto simp: nth_append_Cons)
   from arg_cong[OF ctxt, of "\<lambda> t. gfun_at (gterm_of_term t) (hole_pos C)"] none
   have hp_nt: "ghole_pos (gctxt_of_ctxt C) \<notin> gposs t" unfolding ground_hole_pos_to_ghole[OF gr(2)]
     using gfun_at_gpair[of t u "hole_pos C"] gr *
     by (cases s) (auto simp flip: poss_gposs_mem_conv split: if_splits elim: gfun_at_possE)
   from gpair_ctxt_decomposition[OF hp_nt, of u "gsubt_at u (hole_pos C)"]
   have to_gpair: "gpair t (gctxt_at_pos u (hole_pos C))\<langle>v\<rangle>\<^sub>G = (gctxt_of_ctxt C)\<langle>gterm_to_None_Some v\<rangle>\<^sub>G" for v
     unfolding ground_hole_pos_to_ghole[OF gr(2)] using ctxt gr
     using subst_at_gpair_nt_poss_None_Some[OF _ hp_nt, of u]
     by (metis (no_types, lifting) UnE \<open>ghole_pos (gctxt_of_ctxt C) = hole_pos C\<close>
         gposs_of_gpair gsubt_at_gctxt_apply_ghole hole_pos_in_ctxt_apply hp_nt poss_gposs_conv term_of_gterm_ctxt_apply)
   have inf: "infinite {v. gpair t ((gctxt_at_pos u (hole_pos C))\<langle>v\<rangle>\<^sub>G) \<in> \<L> \<A>}" using fin
     by (intro infinite_super[OF _ inf]) (auto simp: \<L>_def gta_der_def simp flip: to_gpair)
   have "infinite {u |u. gpair t u \<in> \<L> \<A>}"
     by (intro infinite_super[OF _ infinite_inj_image_infinite[OF inf gctxt_apply_inj_on_term[of "gctxt_at_pos u (hole_pos C)"]]])
        (auto simp: image_def intro: infinite_super)
   then show ?thesis using assms(1, 2)
     by (intro aux_lemma[of \<A>]) simp
 qed
 
 lemma Inf_automata_subseteq:
   "\<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>)) \<subseteq> \<L> \<A>" (is "\<L> ?IA \<subseteq> _")
 proof
   fix s assume l: "s \<in> \<L> ?IA"
   then obtain q where w: "q |\<in>| fin ?IA" "q |\<in>| ta_der (ta ?IA) (term_of_gterm s)"
     by (auto simp: \<L>_def elim!: gta_langE)
   from w(1) have "remove_sum q |\<in>| fin \<A>"
     by (auto simp: Inf_reg_def Inf_automata_def)
   then show "s \<in> \<L> \<A>" using Inf_automata_dash_reach_to_reach[of q "ta \<A>"] w(2)
     by (auto simp: gterm.map_ident \<L>_def Inf_reg_def)
        (metis gta_langI map_vars_term_term_of_gterm)
 qed
 
 lemma \<L>_Inf_reg:
   assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)"
   shows "gfst ` \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>)) = Inf_branching_terms \<R> \<F>"
 proof -
   {fix s assume ass: "s \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))"
     then have "\<exists> t u. s = gpair t u" using Inf_automata_subseteq[of \<A> \<F>] assms(1)
       by (auto simp: RR2_spec_def)
     then have "gfst s \<in> Inf_branching_terms \<R> \<F>"
       using ass Inf_automata_to_Inf[OF assms]
       by (force simp: gfst_gpair)}
   then show ?thesis using Inf_to_automata[OF assms(1), of _ \<F>]
     by (auto simp: gfst_gpair) (metis gfst_gpair image_iff)
 qed
 end
\ No newline at end of file
diff --git a/thys/Regular_Tree_Relations/RRn_Automata.thy b/thys/Regular_Tree_Relations/RRn_Automata.thy
--- a/thys/Regular_Tree_Relations/RRn_Automata.thy
+++ b/thys/Regular_Tree_Relations/RRn_Automata.thy
@@ -1,1568 +1,1568 @@
 theory RRn_Automata
   imports Tree_Automata_Complement Ground_Ctxt
 begin
 section \<open>Regular relations\<close>
 
 subsection \<open>Encoding pairs of terms\<close>
 
 text \<open>The encoding of two terms $s$ and $t$ is given by its tree domain, which is the union of the
 domains of $s$ and $t$, and the labels, which arise from looking up each position in $s$ and $t$,
 respectively.\<close>
 
 definition gpair :: "'f gterm \<Rightarrow> 'g gterm \<Rightarrow> ('f option \<times> 'g option) gterm" where
   "gpair s t = glabel (\<lambda>p. (gfun_at s p, gfun_at t p)) (gunion (gdomain s) (gdomain t))"
 
 text \<open>We provide an efficient implementation of gpair.\<close>
 
 definition zip_fill :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a option \<times> 'b option) list" where
   "zip_fill xs ys = zip (map Some xs @ replicate (length ys - length xs) None)
     (map Some ys @ replicate (length xs - length ys) None)"
 
 lemma zip_fill_code [code]:
   "zip_fill xs [] = map (\<lambda>x. (Some x, None)) xs"
   "zip_fill [] ys = map (\<lambda>y. (None, Some y)) ys"
   "zip_fill (x # xs) (y # ys) = (Some x, Some y) # zip_fill xs ys"
   subgoal by (induct xs) (auto simp: zip_fill_def)
   subgoal by (induct ys) (auto simp: zip_fill_def)
   subgoal by (auto simp: zip_fill_def)
   done
 
 lemma length_zip_fill [simp]:
   "length (zip_fill xs ys) = max (length xs) (length ys)"
   by (auto simp: zip_fill_def)
 
 lemma nth_zip_fill:
   assumes "i < max (length xs) (length ys)"
   shows "zip_fill xs ys ! i = (if i < length xs then Some (xs ! i) else None, if i < length ys then Some (ys ! i) else None)"
   using assms by (auto simp: zip_fill_def nth_append)
 
 fun gpair_impl :: "'f gterm option \<Rightarrow> 'g gterm option \<Rightarrow> ('f option \<times> 'g option) gterm" where
   "gpair_impl (Some s) (Some t) = gpair s t"
 | "gpair_impl (Some s) None     = map_gterm (\<lambda>f. (Some f, None)) s"
 | "gpair_impl None     (Some t) = map_gterm (\<lambda>f. (None, Some f)) t"
 | "gpair_impl None     None     = GFun (None, None) []"
 
 declare gpair_impl.simps(2-4)[code]
 
 lemma gpair_impl_code [simp, code]:
   "gpair_impl (Some s) (Some t) =
     (case s of GFun f ss \<Rightarrow> case t of GFun g ts \<Rightarrow>
     GFun (Some f, Some g) (map (\<lambda>(s, t). gpair_impl s t) (zip_fill ss ts)))"
 proof (induct "gdomain s" "gdomain t" arbitrary: s t rule: gunion.induct)
   case (1 f ss g ts)
   obtain f' ss' where [simp]: "s = GFun f' ss'" by (cases s)
   obtain g' ts' where [simp]: "t = GFun g' ts'" by (cases t)
   show ?case using 1(2,3) 1(1)[of i "ss' ! i" "ts' ! i" for i]
     by (auto simp: gpair_def comp_def nth_zip_fill intro: glabel_map_gterm_conv[unfolded comp_def]
       intro!: nth_equalityI)
 qed
 
 lemma gpair_code [code]:
   "gpair s t = gpair_impl (Some s) (Some t)"
   by simp
 
 (* export_code gpair in Haskell *)
 
 declare gpair_impl.simps(1)[simp del]
 
 text \<open>We can easily prove some basic properties. I believe that proving them by induction with a
 definition along the lines of @{const gpair_impl} would be very cumbersome.\<close>
 
 lemma gpair_swap:
   "map_gterm prod.swap (gpair s t) = gpair t s"
   by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gpair_def)
 
 lemma gpair_assoc:
   defines "f \<equiv> \<lambda>(f, gh). (f, gh \<bind> fst, gh \<bind> snd)"
   defines "g \<equiv> \<lambda>(fg, h). (fg \<bind> fst, fg \<bind> snd, h)"
   shows "map_gterm f (gpair s (gpair t u)) = map_gterm g (gpair (gpair s t) u)"
   by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gpair_def f_def g_def)
 
 
 subsection \<open>Decoding of pairs\<close>
 
 fun gcollapse :: "'f option gterm \<Rightarrow> 'f gterm option" where
   "gcollapse (GFun None _) = None"
 | "gcollapse (GFun (Some f) ts) = Some (GFun f (map the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts))))"
 
 lemma gcollapse_groot_None [simp]:
   "groot_sym t = None \<Longrightarrow> gcollapse t = None"
   "fst (groot t) = None \<Longrightarrow> gcollapse t = None"
   by (cases t, simp)+
 
 definition gfst :: "('f option \<times> 'g option) gterm \<Rightarrow> 'f gterm" where
   "gfst = the \<circ> gcollapse \<circ> map_gterm fst"
 
 definition gsnd :: "('f option \<times> 'g option) gterm \<Rightarrow> 'g gterm" where
   "gsnd = the \<circ> gcollapse \<circ> map_gterm snd"
 
 lemma filter_less_upt:
   "[i\<leftarrow>[i..<m] . i < n] = [i..<min n m]"
 proof (cases "i \<le> m")
   case True then show ?thesis
   proof (induct rule: inc_induct)
     case (step n) then show ?case by (auto simp: upt_rec[of n])
   qed simp
 qed simp
 
 lemma gcollapse_aux:
   assumes "gposs s = {p. p \<in> gposs t \<and> gfun_at t p \<noteq> Some None}"
   shows "gposs (the (gcollapse t)) = gposs s"
     "\<And>p. p \<in> gposs s \<Longrightarrow> gfun_at (the (gcollapse t)) p = (gfun_at t p \<bind> id)"
 proof (goal_cases)
   define s' t' where "s' \<equiv> gdomain s" and "t' \<equiv> gdomain t"
   have *: "gposs (the (gcollapse t)) = gposs s \<and>
     (\<forall>p. p \<in> gposs s \<longrightarrow> gfun_at (the (gcollapse t)) p = (gfun_at t p \<bind> id))"
   using assms s'_def t'_def
   proof (induct s' t' arbitrary: s t rule: gunion.induct)
     case (1 f' ss' g' ts')
     obtain f ss where s [simp]: "s = GFun f ss" by (cases s)
     obtain g ts where t [simp]: "t = GFun (Some g) ts"
       using arg_cong[OF 1(2), of "\<lambda>P. [] \<in> P"] by (cases t) auto
     have *: "i < length ts \<Longrightarrow> \<not> Option.is_none (gcollapse (ts ! i)) \<longleftrightarrow> i < length ss" for i
       using arg_cong[OF 1(2), of "\<lambda>P. [i] \<in> P"] by (cases "ts ! i") auto
     have l: "length ss \<le> length ts"
       using arg_cong[OF 1(2), of "\<lambda>P. [length ss-1] \<in> P"] by auto
     have [simp]: "[t\<leftarrow>map gcollapse ts . \<not> Option.is_none t] = take (length ss) (map gcollapse ts)"
       by (subst (2) map_nth[symmetric]) (auto simp add: * filter_map comp_def filter_less_upt
         cong: filter_cong[OF refl, of "[0..<length ts]", unfolded set_upt atLeastLessThan_iff]
         intro!: nth_equalityI)
     have [simp]: "i < length ss \<Longrightarrow> gposs (ss ! i) = gposs (the (gcollapse (ts ! i)))" for i
       using conjunct1[OF 1(1), of i "ss ! i" "ts ! i"] l arg_cong[OF 1(2), of "\<lambda>P. {p. i # p \<in> P}"]
         1(3,4) by simp
     show ?case
     proof (intro conjI allI, goal_cases A B)
       case A show ?case using l by (auto simp: comp_def split: if_splits)
     next
       case (B p) show ?case
       proof (cases p)
         case (Cons i q) then show ?thesis using arg_cong[OF 1(2), of "\<lambda>P. {p. i # p \<in> P}"]
           spec[OF conjunct2[OF 1(1)], of i "ss ! i" "ts ! i" q] 1(3,4) by auto
       qed auto
     qed
   qed
   { case 1 then show ?case using * by blast
   next
     case 2 then show ?case using * by blast }
 qed
 
 lemma gfst_gpair:
   "gfst (gpair s t) = s"
 proof -
   have *: "gposs s = {p \<in> gposs (map_gterm fst (gpair s t)). gfun_at (map_gterm fst (gpair s t)) p \<noteq> Some None}"
     using gfun_at_nongposs
     by (fastforce simp: gpair_def elim: gfun_at_possE)
   show ?thesis unfolding gfst_def comp_def using gcollapse_aux[OF *]
     by (auto intro!: eq_gterm_by_gposs_gfun_at simp: gpair_def)
 qed
 
 lemma gsnd_gpair:
   "gsnd (gpair s t) = t"
   using gfst_gpair[of t s] gpair_swap[of t s, symmetric]
   by (simp add: gfst_def gsnd_def gpair_def gterm.map_comp comp_def)
 
 lemma gpair_impl_None_Inv:
   "map_gterm (the \<circ> snd) (gpair_impl None (Some t)) = t"
   by (simp add: gterm.map_ident gterm.map_comp comp_def)
 
 subsection \<open>Contexts to gpair\<close>
 
 lemma gpair_context1:
   assumes "length ts = length us"
   shows "gpair (GFun f ts) (GFun f us) = GFun (Some f, Some f) (map (case_prod gpair) (zip ts us))"
   using assms unfolding gpair_code by (auto intro!: nth_equalityI simp: zip_fill_def)
 
 lemma gpair_context2:
   assumes "\<And> i. i < length ts \<Longrightarrow> ts ! i = gpair (ss ! i) (us ! i)"
   and "length ss = length ts" and "length us = length ts"
   shows "GFun (Some f, Some h) ts = gpair (GFun f ss) (GFun h us)"
   using assms unfolding gpair_code gpair_impl_code
   by (auto simp: zip_fill_def intro!: nth_equalityI)
 
 lemma map_funs_term_some_gpair:
   shows "gpair t t = map_gterm (\<lambda>f. (Some f, Some f)) t"
 proof (induct t)
   case (GFun f ts)
   then show ?case by (auto intro!: gpair_context2[symmetric])
 qed
 
 
 lemma gpair_inject [simp]:
   "gpair s t = gpair s' t' \<longleftrightarrow> s = s' \<and> t = t'"
   by (metis gfst_gpair gsnd_gpair)
 
 abbreviation gterm_to_None_Some :: "'f gterm \<Rightarrow> ('f option \<times> 'f option) gterm" where
   "gterm_to_None_Some t \<equiv> map_gterm (\<lambda>f. (None, Some f)) t"
 abbreviation "gterm_to_Some_None t \<equiv> map_gterm (\<lambda>f. (Some f, None)) t"
 
 lemma inj_gterm_to_None_Some: "inj gterm_to_None_Some"
     by (meson Pair_inject gterm.inj_map inj_onI option.inject)
 
 lemma zip_fill1:
   assumes "length ss < length ts"
   shows "zip_fill ss ts = zip (map Some ss) (map Some (take (length ss) ts)) @
     map (\<lambda> x. (None, Some x)) (drop (length ss) ts)"
   using assms by (auto simp: zip_fill_def list_eq_iff_nth_eq nth_append simp add: min.absorb2)
 
 lemma zip_fill2:
   assumes "length ts < length ss"
   shows "zip_fill ss ts = zip (map Some (take (length ts) ss)) (map Some ts) @
     map (\<lambda> x. (Some x, None)) (drop (length ts) ss)"
   using assms by (auto simp: zip_fill_def list_eq_iff_nth_eq nth_append simp add: min.absorb2)
 
 (* GPair position lemmas *)
 
 (* MOVE me*)
 lemma not_gposs_append [simp]:
   assumes "p \<notin> gposs t"
   shows "p @ q \<in> gposs t = False" using assms poss_gposs_conv
   using poss_append_poss by blast
 
 (*end Move *)
 
 lemma gfun_at_gpair:
   "gfun_at (gpair s t) p = (if p \<in> gposs s then (if p \<in> gposs t
                                                  then Some (gfun_at s p, gfun_at t p)
                                                  else Some (gfun_at s p, None)) else
                            (if p \<in> gposs t then Some (None, gfun_at t p) else None))"
   using gfun_at_glabel by (auto simp: gpair_def)
 
 lemma gposs_of_gpair [simp]:
   shows "gposs (gpair s t) = gposs s \<union> gposs t"
   by (auto simp: gpair_def)
 
 lemma poss_to_gpair_poss:
   "p \<in> gposs s \<Longrightarrow> p \<in> gposs (gpair s t)"
   "p \<in> gposs t \<Longrightarrow> p \<in> gposs (gpair s t)"
   by auto
 
 lemma gsubt_at_gpair_poss:
   assumes "p \<in> gposs s" and "p \<in> gposs t"
   shows "gsubt_at (gpair s t) p = gpair (gsubt_at s p) (gsubt_at t p)" using assms
   by (auto simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at)
 
 lemma subst_at_gpair_nt_poss_Some_None:
   assumes "p \<in> gposs s" and "p \<notin> gposs t"
   shows "gsubt_at (gpair s t) p = gterm_to_Some_None (gsubt_at s p)" using assms gfun_at_poss
   by (force simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at)
 
 lemma subst_at_gpair_nt_poss_None_Some:
   assumes "p \<in> gposs t" and "p \<notin> gposs s"
   shows "gsubt_at (gpair s t) p = gterm_to_None_Some (gsubt_at t p)" using assms gfun_at_poss
   by (force simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at)
 
 
 lemma gpair_ctxt_decomposition:
   fixes C defines "p \<equiv> ghole_pos C"
   assumes "p \<notin> gposs s" and "gpair s t = C\<langle>gterm_to_None_Some u\<rangle>\<^sub>G"
   shows "gpair s (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G = C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G"
   using assms(2-)
 proof -
   note p[simp] = assms(1)
   have pt: "p \<in> gposs t" and pc: "p \<in> gposs C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G"
     and pu: "p \<in> gposs C\<langle>gterm_to_None_Some u\<rangle>\<^sub>G"
     using arg_cong[OF assms(3), of gposs] assms(2) ghole_pos_in_apply
     by auto
   have *: "gctxt_at_pos (gpair s (gctxt_at_pos t (ghole_pos C))\<langle>v\<rangle>\<^sub>G) (ghole_pos C) = gctxt_at_pos (gpair s t) (ghole_pos C)"
     using assms(2) pt
     by (intro eq_gctxt_at_pos)
       (auto simp: gposs_gctxt_at_pos gunion_gsubt_at_poss gfun_at_gpair gfun_at_gctxt_at_pos_not_after)
   have "gsubt_at (gpair s (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G) p = gsubt_at C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G p"
     using pt assms(2) subst_at_gpair_nt_poss_None_Some[OF _ assms(2), of "(gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G"]
     using ghole_pos_gctxt_at_pos
     by (simp add: ghole_pos_in_apply)
   then show ?thesis using assms(2) ghole_pos_gctxt_at_pos
     using gsubst_at_gctxt_at_eq_gtermD[OF assms(3) pu]
     by (intro gsubst_at_gctxt_at_eq_gtermI[OF _ pc])
        (auto simp: ghole_pos_in_apply * gposs_gctxt_at_pos[OF pt, unfolded p])
 qed
 
 lemma groot_gpair [simp]:
   "fst (groot (gpair s t)) = (Some (fst (groot s)), Some (fst (groot t)))"
   by (cases s; cases t) (auto simp add: gpair_code)
 
 lemma ground_ctxt_adapt_ground [intro]:
   assumes "ground_ctxt C"
   shows "ground_ctxt (adapt_vars_ctxt C)"
   using assms by (induct C) auto
 
 lemma adapt_vars_ctxt2 :
   assumes "ground_ctxt C"
   shows "adapt_vars_ctxt (adapt_vars_ctxt C) = adapt_vars_ctxt C" using assms
   by (induct C) (auto simp: adapt_vars2)
 
 subsection \<open>Encoding of lists of terms\<close>
 
 definition gencode :: "'f gterm list \<Rightarrow> 'f option list gterm" where
   "gencode ts = glabel (\<lambda>p. map (\<lambda>t. gfun_at t p) ts) (gunions (map gdomain ts))"
 
 definition gdecode_nth :: "'f option list gterm \<Rightarrow> nat \<Rightarrow> 'f gterm" where
   "gdecode_nth t i = the (gcollapse (map_gterm (\<lambda>f. f ! i) t))"
 
 lemma gdecode_nth_gencode:
   assumes "i < length ts"
   shows "gdecode_nth (gencode ts) i = ts ! i"
 proof -
   have *: "gposs (ts ! i) = {p \<in> gposs (map_gterm (\<lambda>f. f ! i) (gencode ts)).
            gfun_at (map_gterm (\<lambda>f. f ! i) (gencode ts)) p \<noteq> Some None}"
     using assms
     by (auto simp: gencode_def elim: gfun_at_possE dest: gfun_at_poss_gpossD) (force simp: fun_at_def' split: if_splits)
   show ?thesis unfolding gdecode_nth_def comp_def using assms gcollapse_aux[OF *]
     by (auto intro!: eq_gterm_by_gposs_gfun_at simp: gencode_def)
      (metis (no_types) gposs_map_gterm length_map list.set_map map_nth_eq_conv nth_mem) 
 qed
 
 definition gdecode :: "'f option list gterm \<Rightarrow> 'f gterm list" where
   "gdecode t = (case t of GFun f ts \<Rightarrow> map (\<lambda>i. gdecode_nth t i) [0..<length f])"
 
 lemma gdecode_gencode:
   "gdecode (gencode ts) = ts"
 proof (cases "gencode ts")
   case (GFun f ts')
   have "length f = length ts" using arg_cong[OF GFun, of "\<lambda>t. gfun_at t []"]
     by (auto simp: gencode_def)
   then show ?thesis using gdecode_nth_gencode[of _ ts]
     by (auto intro!: nth_equalityI simp: gdecode_def GFun)
 qed
 
 definition gencode_impl :: "'f gterm option list \<Rightarrow> 'f option list gterm" where
   "gencode_impl ts = glabel (\<lambda>p. map (\<lambda>t. t \<bind> (\<lambda>t. gfun_at t p)) ts) (gunions (map (case_option (GFun () []) gdomain) ts))"
 
 lemma gencode_code [code]:
   "gencode ts = gencode_impl (map Some ts)"
   by (auto simp: gencode_def gencode_impl_def comp_def)
 
 lemma gencode_singleton:
   "gencode [t] = map_gterm (\<lambda>f. [Some f]) t"
   using glabel_map_gterm_conv[unfolded comp_def, of "\<lambda>t. [t]" t]
   by (simp add: gunions_def gencode_def)
 
 lemma gencode_pair:
   "gencode [t, u] = map_gterm (\<lambda>(f, g). [f, g]) (gpair t u)"
   by (simp add: gunions_def gencode_def gpair_def map_gterm_glabel comp_def)
 
 
 subsection \<open>RRn relations\<close>
 
 definition RR1_spec where
   "RR1_spec A T \<longleftrightarrow> \<L> A = T"
 
 definition RR2_spec where
   "RR2_spec A T \<longleftrightarrow> \<L> A = {gpair t u |t u. (t, u) \<in> T}"
 
 definition RRn_spec where
   "RRn_spec n A R \<longleftrightarrow> \<L> A = gencode ` R \<and> (\<forall>ts \<in> R. length ts = n)"
 
 lemma RR1_to_RRn_spec:
   assumes "RR1_spec A T"
   shows "RRn_spec 1 (fmap_funs_reg (\<lambda>f. [Some f]) A) ((\<lambda>t. [t]) ` T)"
 proof -
   have [simp]: "inj_on (\<lambda>f. [Some f]) X" for X by (auto simp: inj_on_def)
   show ?thesis using assms
     by (auto simp: RR1_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def gencode_singleton)
 qed
 
 lemma RR2_to_RRn_spec:
   assumes "RR2_spec A T"
   shows "RRn_spec 2 (fmap_funs_reg (\<lambda>(f, g). [f, g]) A) ((\<lambda>(t, u). [t, u]) ` T)"
 proof -
   have [simp]: "inj_on (\<lambda>(f, g). [f, g]) X" for X by (auto simp: inj_on_def)
   show ?thesis using assms
     by (auto simp: RR2_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def prod.case_distrib gencode_pair)
 qed
 
 lemma RRn_to_RR2_spec:
   assumes "RRn_spec 2 A T"
   shows "RR2_spec (fmap_funs_reg (\<lambda> f. (f ! 0 ,  f ! 1)) A) ((\<lambda> f. (f ! 0, f ! 1)) ` T)" (is "RR2_spec ?A ?T")
 proof -
   {fix xs assume "xs \<in> T" then have "length xs = 2" using assms by (auto simp: RRn_spec_def)
     then obtain t u where *: "xs = [t, u]"
       by (metis (no_types, lifting) One_nat_def Suc_1 length_0_conv length_Suc_conv)
     have **: "(\<lambda>f. (f ! 0, f ! Suc 0)) \<circ> (\<lambda>(f, g). [f, g]) = id" by auto
     have "map_gterm (\<lambda>f. (f ! 0, f ! Suc 0)) (gencode xs) = gpair t u"
       unfolding * gencode_pair gterm.map_comp ** gterm.map_id ..
     then have "\<exists> t u. xs = [t, u] \<and> map_gterm (\<lambda>f. (f ! 0, f ! Suc 0)) (gencode xs) = gpair t u"
       using * by blast}
   then show ?thesis using assms
     by (force simp: RR2_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def prod.case_distrib gencode_pair image_iff Bex_def)
 qed
 
 lemma relabel_RR1_spec [simp]:
   "RR1_spec (relabel_reg A) T \<longleftrightarrow> RR1_spec A T"
   by (simp add: RR1_spec_def)
 
 lemma relabel_RR2_spec [simp]:
   "RR2_spec (relabel_reg A) T \<longleftrightarrow> RR2_spec A T"
   by (simp add: RR2_spec_def)
 
 lemma relabel_RRn_spec [simp]:
   "RRn_spec n (relabel_reg A) T \<longleftrightarrow> RRn_spec n A T"
   by (simp add: RRn_spec_def)
 
 lemma trim_RR1_spec [simp]:
   "RR1_spec (trim_reg A) T \<longleftrightarrow> RR1_spec A T"
   by (simp add: RR1_spec_def \<L>_trim)
 
 lemma trim_RR2_spec [simp]:
   "RR2_spec (trim_reg A) T \<longleftrightarrow> RR2_spec A T"
   by (simp add: RR2_spec_def \<L>_trim)
 
 lemma trim_RRn_spec [simp]:
   "RRn_spec n (trim_reg A) T \<longleftrightarrow> RRn_spec n A T"
   by (simp add: RRn_spec_def \<L>_trim)
 
 lemma swap_RR2_spec:
   assumes "RR2_spec A R"
   shows "RR2_spec (fmap_funs_reg prod.swap A) (prod.swap ` R)" using assms
   by (force simp add: RR2_spec_def fmap_funs_\<L> gpair_swap image_iff)
 
 subsection \<open>Nullary automata\<close>
 
 lemma false_RRn_spec:
   "RRn_spec n empty_reg {}"
   by (auto simp: RRn_spec_def \<L>_epmty)
 
 lemma true_RR0_spec:
   "RRn_spec 0 (Reg {|q|} (TA {|[] [] \<rightarrow> q|} {||})) {[]}"
   by (auto simp: RRn_spec_def \<L>_def const_ta_lang gencode_def gunions_def)
 
 subsection \<open>Pairing RR1 languages\<close>
 
 text \<open>cf. @{const "gpair"}.\<close>
 
 abbreviation "lift_Some_None s \<equiv> (Some s, None)"
 abbreviation "lift_None_Some s \<equiv> (None, Some s)"
 abbreviation "pair_eps A B \<equiv> (\<lambda> (p, q). ((Some (fst p), q), (Some (snd p), q))) |`| (eps A |\<times>| finsert None (Some |`| \<Q> B))"
 abbreviation "pair_rule \<equiv> (\<lambda> (ra, rb). TA_rule (Some (r_root ra), Some (r_root rb)) (zip_fill (r_lhs_states ra) (r_lhs_states rb)) (Some (r_rhs ra), Some (r_rhs rb)))"
 
 lemma lift_Some_None_pord_swap [simp]:
   "prod.swap \<circ> lift_Some_None = lift_None_Some"
   "prod.swap \<circ> lift_None_Some = lift_Some_None"
   by auto
 
 lemma eps_to_pair_eps_Some_None:
   "(p, q) |\<in>| eps \<A> \<Longrightarrow> (lift_Some_None p, lift_Some_None q) |\<in>| pair_eps \<A> \<B>"
   by force
 
 definition pair_automaton :: "('p, 'f) ta \<Rightarrow> ('q, 'g) ta \<Rightarrow> ('p option \<times> 'q option, 'f option \<times> 'g option) ta" where
   "pair_automaton A B = TA 
     (map_ta_rule lift_Some_None lift_Some_None |`| rules A |\<union>|
      map_ta_rule lift_None_Some lift_None_Some |`| rules B |\<union>|
      pair_rule |`| (rules A |\<times>| rules B))
     (pair_eps A B |\<union>| map_both prod.swap |`| (pair_eps B A))"
 
 definition pair_automaton_reg where
   "pair_automaton_reg R L = Reg (Some |`| fin R |\<times>| Some |`| fin L) (pair_automaton (ta R) (ta L))"
 
 
 lemma pair_automaton_eps_simps:
   "(lift_Some_None p, p') |\<in>| eps (pair_automaton A B) \<longleftrightarrow> (lift_Some_None p, p') |\<in>| pair_eps A B"
   "(q , lift_Some_None q') |\<in>| eps (pair_automaton A B) \<longleftrightarrow> (q , lift_Some_None q') |\<in>| pair_eps A B"
   by (auto simp: pair_automaton_def eps_to_pair_eps_Some_None)
 
 lemma pair_automaton_eps_Some_SomeD:
   "((Some p, Some p'), r) |\<in>| eps (pair_automaton A B) \<Longrightarrow> fst r \<noteq> None \<and> snd r \<noteq> None \<and> (Some p = fst r \<or> Some p' = snd r) \<and>
      (Some p \<noteq> fst r \<longrightarrow> (p, the (fst r)) |\<in>| (eps A)) \<and> (Some p' \<noteq> snd r \<longrightarrow> (p', the (snd r)) |\<in>| (eps B))"
   by (auto simp: pair_automaton_def)
 
 lemma pair_automaton_eps_Some_SomeD2:
   "(r, (Some p, Some p')) |\<in>| eps (pair_automaton A B) \<Longrightarrow> fst r \<noteq> None \<and> snd r \<noteq> None \<and> (fst r = Some p \<or> snd r = Some p') \<and>
      (fst r \<noteq> Some p \<longrightarrow> (the (fst r), p) |\<in>| (eps A)) \<and> (snd r \<noteq> Some p' \<longrightarrow> (the (snd r), p') |\<in>| (eps B))"
   by (auto simp: pair_automaton_def)
 
 lemma pair_eps_Some_None:
   fixes p q q'
   defines "l \<equiv> (p, q)" and "r \<equiv> lift_Some_None q'"
   assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
   shows "q = None \<and> p \<noteq> None \<and> (the p, q') |\<in>| (eps A)|\<^sup>+|" using assms(3, 1, 2)
 proof (induct arbitrary: q' q rule: ftrancl_induct)
   case (Step b)
   then show ?case unfolding pair_automaton_eps_simps
     by (auto simp: pair_automaton_eps_simps)
        (meson not_ftrancl_into)
 qed (auto simp: pair_automaton_def)
 
 lemma pair_eps_Some_Some:
   fixes p q
   defines "l \<equiv> (Some p, Some q)"
   assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
   shows "fst r \<noteq> None \<and> snd r \<noteq> None \<and>
       (fst l \<noteq> fst r \<longrightarrow> (p, the (fst r)) |\<in>| (eps A)|\<^sup>+|) \<and>
       (snd l \<noteq> snd r \<longrightarrow> (q, the (snd r)) |\<in>| (eps B)|\<^sup>+|)"
   using assms(2, 1)
 proof (induct arbitrary: p q rule: ftrancl_induct)
   case (Step b c)
   then obtain r r' where *: "b = (Some r, Some r')" by (cases b) auto
   show ?case using Step(2)
     using pair_automaton_eps_Some_SomeD[OF  Step(3)[unfolded *]]
     by (auto simp: *) (meson not_ftrancl_into)+
 qed (auto simp: pair_automaton_def)
 
 lemma pair_eps_Some_Some2:
   fixes p q
   defines "r \<equiv> (Some p, Some q)"
   assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
   shows "fst l \<noteq> None \<and> snd l \<noteq> None \<and>
       (fst l \<noteq> fst r \<longrightarrow> (the (fst l), p) |\<in>| (eps A)|\<^sup>+|) \<and>
       (snd l \<noteq> snd r \<longrightarrow> (the (snd l), q) |\<in>| (eps B)|\<^sup>+|)"
   using assms(2, 1)
 proof (induct arbitrary: p q rule: ftrancl_induct)
   case (Step b c)
   from pair_automaton_eps_Some_SomeD2[OF Step(3)]
   obtain r r' where *: "c = (Some r, Some r')" by (cases c) auto
   from Step(2)[OF this] show ?case
     using pair_automaton_eps_Some_SomeD[OF  Step(3)[unfolded *]]
     by (auto simp: *) (meson not_ftrancl_into)+
 qed (auto simp: pair_automaton_def)
 
 
 lemma map_pair_automaton:
   "pair_automaton (fmap_funs_ta f A) (fmap_funs_ta g B) =
    fmap_funs_ta (\<lambda>(a, b). (map_option f a, map_option g b)) (pair_automaton A B)" (is "?Ls = ?Rs")
 proof -
   let ?ls = "pair_rule \<circ> map_prod (map_ta_rule id f) (map_ta_rule id g)"
   let ?rs = "map_ta_rule id (\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> pair_rule"
   have *: "(\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> lift_Some_None = lift_Some_None \<circ> f"
     "(\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> lift_None_Some = lift_None_Some \<circ> g"
     by (auto simp: comp_def)
   have "?ls x = ?rs x" for x
     by (cases x) (auto simp: ta_rule.map_sel)
   then have [simp]: "?ls = ?rs" by blast
   then have "rules ?Ls = rules ?Rs"
     unfolding pair_automaton_def fmap_funs_ta_def
     by (simp add: fimage_funion map_ta_rule_comp * map_prod_ftimes)
   moreover have "eps ?Ls = eps ?Rs"
     unfolding pair_automaton_def fmap_funs_ta_def
     by (simp add: fimage_funion \<Q>_def)
   ultimately show ?thesis
     by (intro TA_equalityI) simp
 qed
 
 lemmas map_pair_automaton_12 =
   map_pair_automaton[of _ _ id, unfolded fmap_funs_ta_id option.map_id]
   map_pair_automaton[of id _ _, unfolded fmap_funs_ta_id option.map_id]
 
 lemma fmap_states_funs_ta_commute:
   "fmap_states_ta f (fmap_funs_ta g A) = fmap_funs_ta g (fmap_states_ta f A)"
 proof -
   have [simp]: "map_ta_rule f id (map_ta_rule id g r) = map_ta_rule id g (map_ta_rule f id r)" for r
     by (cases r) auto
   show ?thesis
     by (auto simp: ta_rule.case_distrib fmap_states_ta_def fmap_funs_ta_def fimage_iff fBex_def split: ta_rule.splits)
 qed
 
 lemma states_pair_automaton:
   "\<Q> (pair_automaton A B) |\<subseteq>| (finsert None (Some |`| \<Q> A) |\<times>| (finsert None (Some |`| \<Q> B)))"
   unfolding pair_automaton_def
   apply (intro \<Q>_subseteq_I)
   apply (auto simp: ta_rule.map_sel in_fset_conv_nth nth_zip_fill rule_statesD eps_statesD)
   apply (simp add: rule_statesD)+
   done
 
 
 lemma swap_pair_automaton:
   assumes "(p, q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm t)"
   shows "(q, p) |\<in>| ta_der (pair_automaton B A) (term_of_gterm (map_gterm prod.swap t))"
 proof -
   let ?m = "map_ta_rule prod.swap prod.swap"
   have [simp]: "map prod.swap (zip_fill xs ys) = zip_fill ys xs" for xs ys
     by (auto simp: zip_fill_def zip_nth_conv comp_def intro!: nth_equalityI)
   let ?swp = "\<lambda>X. fmap_states_ta prod.swap (fmap_funs_ta prod.swap X)"
   { fix A B
     let ?AB = "?swp (pair_automaton A B)" and ?BA = "pair_automaton B A"
     have "eps ?AB |\<subseteq>| eps ?BA" "rules ?AB |\<subseteq>| rules ?BA"
       by (auto simp: fmap_states_ta_def fmap_funs_ta_def pair_automaton_def
           fimage_funion comp_def prod.map_comp ta_rule.map_comp)
   } note * = this
   let ?BA = "?swp (?swp (pair_automaton B A))" and ?AB = "?swp (pair_automaton A B)"
   have **: "r |\<in>| rules (pair_automaton B A) \<Longrightarrow> ?m r |\<in>| ?m |`| rules (pair_automaton B A)" for r
     by blast
   have "r |\<in>| rules ?BA \<Longrightarrow> r |\<in>| rules ?AB" "e |\<in>| eps ?BA \<Longrightarrow> e |\<in>| eps ?AB" for r e
     using *[of B A] map_ta_rule_prod_swap_id
-    unfolding fmap_funs_ta_def fmap_states_ta_def
-      by (auto simp: map_ta_rule_comp image_iff fBex_def ta_rule.map_id0 intro!: bexI[of _ "?m r"])
+    unfolding fmap_funs_ta_def fmap_states_ta_def ta.sel
+    by (auto simp: map_ta_rule_comp image_iff ta_rule.map_id0 intro!: bexI[of _ "?m r"]) 
   then have "eps ?BA |\<subseteq>| eps ?AB" "rules ?BA |\<subseteq>| rules ?AB"
     by blast+
   then have "fmap_states_ta prod.swap (fmap_funs_ta prod.swap (pair_automaton A B)) = pair_automaton B A"
     using *[of A B] by (simp add: fmap_states_funs_ta_commute fmap_funs_ta_comp fmap_states_ta_comp TA_equalityI)
   then show ?thesis
     using ta_der_fmap_states_ta[OF ta_der_fmap_funs_ta[OF assms], of prod.swap prod.swap]
     by (simp add: gterm.map_comp comp_def)
 qed
 
 lemma to_ta_der_pair_automaton:
   "p |\<in>| ta_der A (term_of_gterm t) \<Longrightarrow>
     (Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (Some f, None)) t))"
   "q |\<in>| ta_der B (term_of_gterm u) \<Longrightarrow>
     (None, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (None, Some f)) u))"
   "p |\<in>| ta_der A (term_of_gterm t) \<Longrightarrow> q |\<in>| ta_der B (term_of_gterm u) \<Longrightarrow>
     (Some p, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (gpair t u))"
 proof (goal_cases sn ns ss)
   let ?AB = "pair_automaton A B"
   have 1: "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (Some f, None)) s))"
     if "p |\<in>| ta_der A (term_of_gterm s)" for A B p s
   proof (rule fsubsetD[OF ta_der_mono])
     show "rules (fmap_states_ta lift_Some_None (fmap_funs_ta lift_Some_None A)) |\<subseteq>|
       rules (pair_automaton A B)"
       by (auto simp: fmap_states_ta_def fmap_funs_ta_def comp_def ta_rule.map_comp
             pair_automaton_def)
   next
     show "eps (fmap_states_ta lift_Some_None (fmap_funs_ta lift_Some_None A)) |\<subseteq>|
       eps (pair_automaton A B)"
       by (rule fsubsetI)
         (auto simp: fmap_states_ta_def fmap_funs_ta_def pair_automaton_def comp_def fimage.rep_eq
           dest: eps_to_pair_eps_Some_None)
   next
     show "lift_Some_None p |\<in>| ta_der
       (fmap_states_ta lift_Some_None (fmap_funs_ta lift_Some_None A))
       (term_of_gterm (gterm_to_Some_None s))"
       using ta_der_fmap_states_ta[OF ta_der_fmap_funs_ta[OF that], of lift_Some_None]
       using ta_der_fmap_funs_ta ta_der_to_fmap_states_der that by fastforce
   qed
   have 2: "q |\<in>| ta_der B (term_of_gterm t) \<Longrightarrow>
     (None, Some q) |\<in>| ta_der ?AB (term_of_gterm (map_gterm (\<lambda>g. (None, Some g)) t))"
     for q t using swap_pair_automaton[OF 1[of q B t A]] by (simp add: gterm.map_comp comp_def)
   {
     case sn then show ?case by (rule 1)
   next
     case ns then show ?case by (rule 2)
   next
     case ss then show ?case
     proof (induct t arbitrary: p q u)
       case (GFun f ts)
       obtain g us where u [simp]: "u = GFun g us" by (cases u)
       obtain p' ps where p': "f ps \<rightarrow> p' |\<in>| rules A" "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|" "length ps = length ts"
         "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts ! i))" using GFun(2) by auto
       obtain q' qs where q': "g qs \<rightarrow> q' |\<in>| rules B" "q' = q \<or> (q', q) |\<in>| (eps B)|\<^sup>+|" "length qs = length us"
         "\<And>i. i < length us \<Longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us ! i))" using GFun(3) by auto
       have *: "Some p |\<in>| Some |`| \<Q> A" "Some q' |\<in>| Some |`| \<Q> B"
         using p'(2,1) q'(1)
         by (auto simp: rule_statesD eps_trancl_statesD)
       have eps: "p' = p \<and> q' = q \<or> ((Some p', Some q'), (Some p, Some q)) |\<in>| (eps ?AB)|\<^sup>+|"
       proof (cases "p' = p")
         case True note p = this then show ?thesis
         proof (cases "q' = q")
           case False
           then have "(q', q) |\<in>| (eps B)|\<^sup>+|" using q'(2) by auto
           hence "((Some p', Some q'), Some p', Some q) |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
           proof (rule ftrancl_map[rotated])
             fix x y
             assume "(x, y) |\<in>| eps B"
             thus "((Some p', Some x), Some p', Some y) |\<in>| eps (pair_automaton A B)"
               using p'(1)[THEN rule_statesD(1), simplified]
               apply (simp add: pair_automaton_def image_iff fSigma.rep_eq)
               by fastforce
           qed
           thus ?thesis
             by (simp add: p)
         qed (simp add: p)
       next
         case False note p = this
         then have *: "(p', p) |\<in>| (eps A)|\<^sup>+|" using p'(2) by auto
         then have eps: "((Some p', Some q'), Some p, Some q') |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
         proof (rule ftrancl_map[rotated])
           fix x y
           assume "(x, y) |\<in>| eps A"
           then show "((Some x, Some q'), Some y, Some q') |\<in>| eps (pair_automaton A B)"
             using q'(1)[THEN rule_statesD(1), simplified]
             apply (simp add: pair_automaton_def image_iff fSigma.rep_eq)
             by fastforce
         qed
         then show ?thesis
         proof (cases "q' = q")
           case True then show ?thesis using eps
             by simp
         next
           case False
           then have "(q', q) |\<in>| (eps B)|\<^sup>+|" using q'(2) by auto
           then have "((Some p, Some q'), Some p, Some q) |\<in>| (eps (pair_automaton A B))|\<^sup>+|"
             apply (rule ftrancl_map[rotated])
             using *[THEN eps_trancl_statesD]
             apply (simp add: p pair_automaton_def image_iff fSigma.rep_eq)
             by fastforce
             
           then show ?thesis using eps
             by (meson ftrancl_trans)
         qed
       qed
       have "(Some f, Some g) zip_fill ps qs \<rightarrow> (Some p', Some q') |\<in>| rules ?AB"
         using p'(1) q'(1) by (force simp: pair_automaton_def)
       then show ?case using GFun(1)[OF nth_mem p'(4) q'(4)] p'(1 - 3)  q'(1 - 3) eps
         using 1[OF p'(4), of _ B] 2[OF q'(4)]
         by (auto simp: gpair_code nth_zip_fill less_max_iff_disj
                     intro!: exI[of _ "zip_fill ps qs"] exI[of _ "Some p'"] exI[of _ "Some q'"])
     qed
   }
 qed
 
 lemma from_ta_der_pair_automaton:
   "(None, None) |\<notin>| ta_der (pair_automaton A B) (term_of_gterm s)"
   "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow>
     \<exists>t. p |\<in>| ta_der A (term_of_gterm t) \<and> s = map_gterm (\<lambda>f. (Some f, None)) t"
   "(None, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow>
     \<exists>u. q |\<in>| ta_der B (term_of_gterm u) \<and> s = map_gterm (\<lambda>f. (None, Some f)) u"
   "(Some p, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow>
    \<exists>t u. p |\<in>| ta_der A (term_of_gterm t) \<and> q |\<in>| ta_der B (term_of_gterm u) \<and> s = gpair t u"
 proof (goal_cases nn sn ns ss)
   let ?AB = "pair_automaton A B"
   { fix p s A B assume "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s)"
     then have "\<exists>t. p |\<in>| ta_der A (term_of_gterm t) \<and> s = map_gterm (\<lambda>f. (Some f, None)) t"
     proof (induct s arbitrary: p)
       case (GFun h ss)
       obtain rs sp nq where r: "h rs \<rightarrow> (sp, nq) |\<in>| rules (pair_automaton A B)"
         "sp = Some p \<and> nq = None \<or> ((sp, nq), (Some p, None)) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" "length rs = length ss"
         "\<And>i. i < length ss \<Longrightarrow> rs ! i |\<in>| ta_der (pair_automaton A B) (term_of_gterm (ss ! i))"
         using GFun(2) by auto
       obtain p' where pq: "sp = Some p'" "nq = None" "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|"
         using r(2) pair_eps_Some_None[of sp nq p A B]
         by (cases sp) auto
       obtain f ps where h: "h = lift_Some_None f" "rs = map lift_Some_None ps"
         "f ps \<rightarrow> p' |\<in>| rules A"
         using r(1) unfolding pq(1, 2) by (auto simp: pair_automaton_def map_ta_rule_cases)
       obtain ts where "\<And>i. i < length ss \<Longrightarrow>
         ps ! i |\<in>| ta_der A (term_of_gterm (ts i)) \<and> ss ! i = map_gterm (\<lambda>f. (Some f, None)) (ts i)"
         using GFun(1)[OF nth_mem, of i "ps ! i" for i] r(4)[unfolded h(2)] r(3)[unfolded h(2) length_map]
         by auto metis
       then show ?case using h(3) pq(3) r(3)[unfolded h(2) length_map]
         by (intro exI[of _ "GFun f (map ts [0..<length ss])"]) (auto simp: h(1) intro!: nth_equalityI)
     qed
   } note 1 = this
   have 2: "\<exists>u. q |\<in>| ta_der B (term_of_gterm u) \<and> s = map_gterm (\<lambda>g. (None, Some g)) u"
     if "(None, Some q) |\<in>| ta_der ?AB (term_of_gterm s)" for q s
     using 1[OF swap_pair_automaton, OF that]
     by (auto simp: gterm.map_comp comp_def gterm.map_ident
       dest!: arg_cong[of "map_gterm prod.swap _" _ "map_gterm prod.swap", unfolded gterm.map_comp])
   {
     case nn
     then show ?case
       by (intro ta_der_not_reach) (auto simp: pair_automaton_def map_ta_rule_cases)
   next
     case sn then show ?case by (rule 1)
   next
     case ns then show ?case by (rule 2)
   next
     case ss then show ?case
     proof (induct s arbitrary: p q)
       case (GFun h ss)
       obtain rs sp sq where r: "h rs \<rightarrow> (sp, sq) |\<in>| rules ?AB"
         "sp = Some p \<and> sq = Some q \<or> ((sp, sq), (Some p, Some q)) |\<in>| (eps ?AB)|\<^sup>+|" "length rs = length ss"
         "\<And>i. i < length ss \<Longrightarrow> rs ! i |\<in>| ta_der ?AB (term_of_gterm (ss ! i))"
         using GFun(2) by auto
       from r(2) have "sp \<noteq> None" "sq \<noteq> None" using pair_eps_Some_Some2[of "(sp, sq)" p q]
         by auto
       then obtain p' q' where pq: "sp = Some p'" "sq = Some q'"
         "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|" "q' = q \<or> (q', q) |\<in>| (eps B)|\<^sup>+|"
         using r(2) pair_eps_Some_Some[where ?r = "(Some p, Some q)" and ?A = A and ?B = B]
         using pair_eps_Some_Some2[of "(sp, sq)" p q]
         by (cases sp; cases sq) auto
       obtain f g ps qs where h: "h = (Some f, Some g)" "rs = zip_fill ps qs"
         "f ps \<rightarrow> p' |\<in>| rules A" "g qs \<rightarrow> q' |\<in>| rules B"
         using r(1) unfolding pq(1,2) by (auto simp: pair_automaton_def map_ta_rule_cases)
       have *: "\<exists>t u. ps ! i |\<in>| ta_der A (term_of_gterm t) \<and> qs ! i |\<in>| ta_der B (term_of_gterm u) \<and> ss ! i = gpair t u"
         if "i < length ps" "i < length qs" for i
         using GFun(1)[OF nth_mem, of i "ps ! i" "qs ! i"] r(4)[unfolded pq(1,2) h(2), of i] that
           r(3)[symmetric] by (auto simp: nth_zip_fill h(2))
       { fix i assume "i < length ss"
         then have "\<exists>t u. (i < length ps \<longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm t)) \<and>
             (i < length qs \<longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm u)) \<and>
             ss ! i = gpair_impl (if i < length ps then Some t else None) (if i < length qs then Some u else None)"
           using *[of i] 1[of "ps ! i" A B "ss ! i"] 2[of "qs ! i" "ss ! i"] r(4)[of i] r(3)[symmetric]
           by (cases "i < length ps"; cases "i < length qs")
             (auto simp add: h(2) nth_zip_fill less_max_iff_disj gpair_code split: gterm.splits) }
       then obtain ts us where "\<And>i. i < length ss \<Longrightarrow>
           (i < length ps \<longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts i))) \<and>
           (i < length qs \<longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us i))) \<and>
           ss ! i = gpair_impl (if i < length ps then Some (ts i) else None) (if i < length qs then Some (us i) else None)"
         by metis
       moreover then have "\<And>i. i < length ps \<Longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts i))"
          "\<And>i. i < length qs \<Longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us i))"
         using r(3)[unfolded h(2)] by auto
       ultimately show ?case using h(3,4) pq(3,4) r(3)[symmetric]
         by (intro exI[of _ "GFun f (map ts [0..<length ps])"] exI[of _ "GFun g (map us [0..<length qs])"])
           (auto simp: gpair_code h(1,2) less_max_iff_disj nth_zip_fill intro!: nth_equalityI split: prod.splits gterm.splits)
     qed
   }
 qed
 
 
 lemma diagonal_automaton:
   assumes "RR1_spec A R"
   shows "RR2_spec (fmap_funs_reg (\<lambda>f. (Some f, Some f)) A) {(s, s) | s. s \<in> R}" using assms
   by (auto simp: RR2_spec_def RR1_spec_def fmap_funs_reg_def fmap_funs_gta_lang map_funs_term_some_gpair \<L>_def)
 
 lemma pair_automaton:
   assumes "RR1_spec A T" "RR1_spec B U"
   shows "RR2_spec (pair_automaton_reg A B) (T \<times> U)"
 proof -
   let ?AB = "pair_automaton (ta A) (ta B)"
   { fix t u assume t: "t \<in> T" and u: "u \<in> U"
     obtain p where p: "p |\<in>| fin A" "p |\<in>| ta_der (ta A) (term_of_gterm t)" using t assms(1)
       by (auto simp: RR1_spec_def gta_lang_def \<L>_def gta_der_def)
     obtain q where q: "q |\<in>| fin B" "q |\<in>| ta_der (ta B) (term_of_gterm u)" using u assms(2)
       by (auto simp: RR1_spec_def gta_lang_def \<L>_def gta_der_def)
     have "gpair t u \<in> \<L> (pair_automaton_reg A B)" using p(1) q(1) to_ta_der_pair_automaton(3)[OF p(2) q(2)]
       by (auto simp: pair_automaton_reg_def \<L>_def)
   } moreover
   { fix s assume "s \<in> \<L> (pair_automaton_reg A B)"
     from this[unfolded gta_lang_def \<L>_def]
     obtain r where r: "r |\<in>| fin (pair_automaton_reg A B)" "r |\<in>| gta_der ?AB s"
       by (auto simp: pair_automaton_reg_def)
     obtain p q where pq: "r = (Some p, Some q)" "p |\<in>| fin A" "q |\<in>| fin B"
       using r(1) by (auto simp: pair_automaton_reg_def)
     from from_ta_der_pair_automaton(4)[OF r(2)[unfolded pq(1) gta_der_def]]
     obtain t u where "p |\<in>| ta_der (ta A) (term_of_gterm t)" "q |\<in>| ta_der (ta B) (term_of_gterm u)" "s = gpair t u"
       by (elim exE conjE) note * = this
     then have "t \<in> \<L> A" "u \<in> \<L> B" using pq(2,3)
       by (auto simp: \<L>_def)
     then have "\<exists>t u. s = gpair t u \<and> t \<in> T \<and> u \<in> U" using assms
       by (auto simp: RR1_spec_def *(3) intro!: exI[of _ t, OF exI[of _ u]])
   } ultimately show ?thesis by (auto simp: RR2_spec_def)
 qed
 
 lemma pair_automaton':
   shows "\<L> (pair_automaton_reg A B) = case_prod gpair ` (\<L> A \<times> \<L> B)"
   using pair_automaton[of A _ B] by (auto simp: RR1_spec_def RR2_spec_def)
 
 
 subsection \<open>Collapsing\<close>
 
 text \<open>cf. @{const "gcollapse"}.\<close>
 
 fun collapse_state_list where
   "collapse_state_list Qn Qs [] = [[]]"
 | "collapse_state_list Qn Qs (q # qs) = (let rec = collapse_state_list Qn Qs qs in
     (if q |\<in>| Qn \<and> q |\<in>| Qs then map (Cons None) rec @ map (Cons (Some q)) rec
      else if q |\<in>| Qn then map (Cons None) rec
      else if q |\<in>| Qs then map (Cons (Some q)) rec
      else [[]]))"
 
 lemma collapse_state_list_inner_length:
   assumes "qss = collapse_state_list Qn Qs qs"
     and "\<forall> i < length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs"
     and "i < length qss"
   shows "length (qss ! i) = length qs" using assms
 proof (induct qs arbitrary: qss i)
   case (Cons q qs)
   have "\<forall>i<length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs" using Cons(3) by auto
   then show ?case using Cons(1)[of "collapse_state_list Qn Qs qs"] Cons(2-)
     by (auto simp: Let_def nth_append)
 qed auto
 
 lemma collapse_fset_inv_constr:
   assumes "\<forall> i < length qs'. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or>
     qs ! i |\<in>| Qs \<and> qs' ! i = Some (qs ! i)"
     and "length qs = length qs'"
   shows "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" using assms
 proof (induct qs arbitrary: qs')
   case (Cons q qs)
   have "(tl qs') |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" using Cons(2-)
     by (intro Cons(1)[of "tl qs'"]) (cases qs', auto)
   then show ?case using Cons(2-)
     by (cases qs') (auto simp: Let_def image_def)
 qed auto
 
 lemma collapse_fset_inv_constr2:
   assumes "\<forall> i < length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs"
     and "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" and "i < length qs'"
   shows "qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> qs' ! i = Some (qs ! i)"
   using assms
 proof (induct qs arbitrary: qs' i)
   case (Cons a qs)
   have "i \<noteq> 0 \<Longrightarrow> qs ! (i - 1) |\<in>| Qn \<and> tl qs' ! (i - 1) = None \<or> qs ! (i - 1) |\<in>| Qs \<and> tl qs' ! (i - 1) = Some (qs ! (i - 1))"
     using Cons(2-)
     by (intro Cons(1)[of "tl qs'" "i - 1"]) (auto simp: Let_def split: if_splits)
   then show ?case using Cons(2-)
     by (cases i) (auto simp: Let_def split: if_splits)
 qed auto
 
 definition collapse_rule where
   "collapse_rule A Qn Qs =
     |\<Union>| ((\<lambda> r. fset_of_list (map (\<lambda> qs. TA_rule (r_root r) qs (Some (r_rhs r))) (collapse_state_list Qn Qs (r_lhs_states r)))) |`|
     ffilter (\<lambda> r. (\<forall> i < length (r_lhs_states r). r_lhs_states r ! i |\<in>| Qn \<or> r_lhs_states r ! i |\<in>| Qs))
       (ffilter (\<lambda> r. r_root r \<noteq> None) (rules A)))"
 
 definition collapse_rule_fset where
   "collapse_rule_fset A Qn Qs = (\<lambda> r. TA_rule (the (r_root r)) (map the (filter (\<lambda>q. \<not> Option.is_none q) (r_lhs_states r))) (the (r_rhs r))) |`|
      collapse_rule A Qn Qs"
 
 lemma collapse_rule_set_conv:
   "fset (collapse_rule_fset A Qn Qs) = {TA_rule f (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) q | f qs qs' q.
       TA_rule (Some f) qs q |\<in>| rules A \<and> length qs = length qs' \<and>
       (\<forall>i < length qs. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> (qs' ! i) = Some (qs ! i))} " (is "?Ls = ?Rs")
 proof
   {fix f qs' q qs assume ass: "TA_rule (Some f) qs q |\<in>| rules A"
     "length qs = length qs'"
     "\<forall>i < length qs. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> (qs' ! i) = Some (qs ! i)"
     then have "TA_rule (Some f) qs' (Some q) |\<in>| collapse_rule A Qn Qs"
       using collapse_fset_inv_constr[of qs' qs Qn Qs] unfolding collapse_rule_def
-      by (auto simp: fset_of_list.rep_eq fimage_iff intro!: fBexI[of _ "TA_rule (Some f) qs q"])
+      by (auto simp: fset_of_list.rep_eq fimage_iff intro!: bexI[of _ "TA_rule (Some f) qs q"])
     then have "TA_rule f (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) q \<in> ?Ls"
       unfolding collapse_rule_fset_def
       by (auto simp: image_iff Bex_def intro!: exI[of _"TA_rule (Some f) qs' (Some q)"])}
   then show "?Rs \<subseteq> ?Ls" by blast
 next
   {fix f qs q assume ass: "TA_rule f qs q \<in> ?Ls"
     then obtain ps qs' where w: "TA_rule (Some f) ps q |\<in>| rules A"
       "\<forall> i < length ps. ps ! i |\<in>| Qn \<or> ps ! i |\<in>| Qs" 
       "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs ps)"
       "qs = map the (filter (\<lambda>q. \<not> Option.is_none q) qs')"
       unfolding collapse_rule_fset_def collapse_rule_def
         by (auto simp: ffUnion.rep_eq fset_of_list.rep_eq) (metis ta_rule.collapse)
     then have "\<forall> i < length qs'. ps ! i |\<in>| Qn \<and> qs' ! i = None \<or> ps ! i |\<in>| Qs \<and> qs' ! i = Some (ps ! i)"
       using collapse_fset_inv_constr2
       by metis
     moreover have "length ps = length qs'"
       using collapse_state_list_inner_length[of _ Qn Qs ps]
       using w(2, 3) calculation(1)
       by (auto simp: in_fset_conv_nth)
     ultimately have "TA_rule f qs q \<in> ?Rs"
       using w(1) unfolding w(4)
       by auto fastforce}
   then show "?Ls \<subseteq> ?Rs" 
     by (intro subsetI) (metis (no_types, lifting) ta_rule.collapse) 
 qed
 
 
 lemma collapse_rule_fmember [simp]:
   "TA_rule f qs q |\<in>| (collapse_rule_fset A Qn Qs) \<longleftrightarrow> (\<exists> qs' ps.
    qs = map the (filter (\<lambda>q. \<not> Option.is_none q) qs') \<and> TA_rule (Some f) ps q |\<in>| rules A \<and> length ps = length qs' \<and>
   (\<forall>i < length ps. ps ! i |\<in>| Qn \<and> qs' ! i = None \<or> ps ! i |\<in>| Qs \<and> (qs' ! i) = Some (ps ! i)))"
   unfolding collapse_rule_set_conv
   by auto
 
 definition "Qn A \<equiv> (let S = (r_rhs |`| ffilter (\<lambda> r. r_root r = None) (rules A)) in (eps A)|\<^sup>+| |``| S |\<union>| S)"
 definition "Qs A \<equiv> (let S = (r_rhs |`| ffilter (\<lambda> r. r_root r \<noteq> None) (rules A)) in (eps A)|\<^sup>+| |``| S |\<union>| S)"
 
 lemma Qn_member_iff [simp]:
   "q |\<in>| Qn A \<longleftrightarrow> (\<exists> ps p. TA_rule None ps p |\<in>| rules A \<and> (p = q \<or> (p, q) |\<in>| (eps A)|\<^sup>+|))" (is "?Ls \<longleftrightarrow> ?Rs")
 proof -
   {assume ass: "q |\<in>| Qn A" then obtain r where
       "r_rhs r = q \<or> (r_rhs r, q) |\<in>| (eps A)|\<^sup>+|" "r |\<in>| rules A" "r_root r = None"
       by (force simp: Qn_def Image_def image_def Let_def fImage.rep_eq)
     then have "?Ls \<Longrightarrow> ?Rs"  by (cases r) auto}
   moreover have "?Rs \<Longrightarrow> ?Ls" by (force simp: Qn_def Image_def image_def Let_def fImage.rep_eq)
   ultimately show ?thesis by blast
 qed
 
 lemma Qs_member_iff [simp]:
   "q |\<in>| Qs A \<longleftrightarrow> (\<exists> f ps p. TA_rule (Some f) ps p |\<in>| rules A \<and> (p = q \<or> (p, q) |\<in>| (eps A)|\<^sup>+|))"  (is "?Ls \<longleftrightarrow> ?Rs")
 proof -
   {assume ass: "q |\<in>| Qs A" then obtain f r where
       "r_rhs r = q \<or> (r_rhs r, q) |\<in>| (eps A)|\<^sup>+|" "r |\<in>| rules A" "r_root r = Some f"
       by (force simp: Qs_def Image_def image_def Let_def fImage.rep_eq)
     then have "?Ls \<Longrightarrow> ?Rs"  by (cases r) auto}
   moreover have "?Rs \<Longrightarrow> ?Ls" by (force simp: Qs_def Image_def image_def Let_def fImage.rep_eq)
   ultimately show ?thesis by blast
 qed
 
 
 lemma collapse_Qn_Qs_set_conv:
   "fset (Qn A) = {q' |qs q q'. TA_rule None qs q |\<in>| rules A \<and> (q = q' \<or> (q, q') |\<in>| (eps A)|\<^sup>+|)}" (is "?Ls1 = ?Rs1")
   "fset (Qs A) = {q' |f qs q q'. TA_rule (Some f) qs q |\<in>| rules A \<and> (q = q' \<or> (q, q') |\<in>| (eps A)|\<^sup>+|)}"  (is "?Ls2 = ?Rs2")
   by auto force+
 
 definition collapse_automaton :: "('q, 'f option) ta \<Rightarrow> ('q, 'f) ta" where
   "collapse_automaton A = TA (collapse_rule_fset A (Qn A) (Qs A)) (eps A)"
 
 definition collapse_automaton_reg where
   "collapse_automaton_reg R = Reg (fin R) (collapse_automaton (ta R))"
 
 lemma ta_states_collapse_automaton:
   "\<Q> (collapse_automaton A) |\<subseteq>| \<Q> A"
   apply (intro \<Q>_subseteq_I)
   apply (auto simp: collapse_automaton_def collapse_Qn_Qs_set_conv collapse_rule_set_conv
     fset_of_list.rep_eq in_set_conv_nth rule_statesD eps_statesD[unfolded])
   apply (metis Option.is_none_def fnth_mem option.sel rule_statesD(3) ta_rule.sel(2))
   done
 
 lemma last_nthI:
   assumes "i < length ts" "\<not> i < length ts - Suc 0"
   shows "ts ! i = last ts" using assms
   by (induct ts arbitrary: i)
     (auto, metis last_conv_nth length_0_conv less_antisym nth_Cons')
 
 lemma collapse_automaton':
   assumes "\<Q> A |\<subseteq>| ta_reachable A" (* cf. ta_trim *)
   shows "gta_lang Q (collapse_automaton A) = the ` (gcollapse ` gta_lang Q A - {None})"
 proof -
   define Qn' where "Qn' = Qn A"
   define Qs' where "Qs' = Qs A"
   {fix t assume t: "t \<in> gta_lang Q (collapse_automaton A)"
     then obtain q where q: "q |\<in>| Q" "q |\<in>| ta_der (collapse_automaton A) (term_of_gterm t)" by auto
     have "\<exists> t'. q |\<in>| ta_der A (term_of_gterm t') \<and> gcollapse t' \<noteq> None \<and> t = the (gcollapse t')" using q(2)
     proof (induct rule: ta_der_gterm_induct)
       case (GFun f ts ps p q)
       from GFun(1 - 3) obtain qs rs where ps: "TA_rule (Some f) qs p |\<in>| rules A" "length qs = length rs"
         "\<And>i. i < length qs \<Longrightarrow> qs ! i |\<in>| Qn' \<and> rs ! i = None \<or> qs ! i |\<in>| Qs' \<and> rs ! i = Some (qs ! i)"
         "ps = map the (filter (\<lambda>q. \<not> Option.is_none q) rs)"
         by (auto simp: collapse_automaton_def Qn'_def Qs'_def)
       obtain ts' where ts':
         "ps ! i |\<in>| ta_der A (term_of_gterm (ts' i))" "gcollapse (ts' i) \<noteq> None" "ts ! i = the (gcollapse (ts' i))"
         if "i < length ts" for i using GFun(5) by metis
       from ps(2, 3, 4) have rs: "i < length qs \<Longrightarrow> rs ! i = None \<or> rs ! i = Some (qs ! i)" for i
         by auto
       {fix i assume "i < length qs" "rs ! i = None"
         then have "\<exists> t'. groot_sym t' = None \<and> qs ! i |\<in>| ta_der A (term_of_gterm t')"
           using ps(1, 2) ps(3)[of i]
           by (auto simp: ta_der_trancl_eps Qn'_def groot_sym_groot_conv elim!: ta_reachable_rule_gtermE[OF assms])
              (force dest: ta_der_trancl_eps)+}
       note None = this
       {fix i assume i: "i < length qs" "rs ! i = Some (qs ! i)"
         have "map Some ps = filter (\<lambda>q. \<not> Option.is_none q) rs" using ps(4)
           by (induct rs arbitrary: ps) (auto simp add: Option.is_none_def)
         from filter_rev_nth_idx[OF _ _ this, of i]
         have *: "rs ! i = map Some ps ! filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i"
           "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i < length ps"
           using ps(2, 4) i by auto
         then have "the (rs ! i) = ps ! filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i"
           "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i < length ps"
           by auto} note Some = this
       let ?P = "\<lambda> t i. qs ! i |\<in>| ta_der A (term_of_gterm t) \<and>
           (rs ! i = None \<longrightarrow> groot_sym t = None) \<and>
           (rs ! i = Some (qs ! i) \<longrightarrow> t = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i))"
       {fix i assume i: "i < length qs"
         then have "\<exists> t. ?P t i" using Some[OF i] None[OF i] ts' ps(2, 4) GFun(2) rs[OF i]
           by (cases "rs ! i") auto}
       then obtain ts'' where ts'': "length ts'' = length qs"
         "i < length qs \<Longrightarrow> qs ! i |\<in>| ta_der A (term_of_gterm (ts'' ! i))"
         "i < length qs \<Longrightarrow> rs ! i = None \<Longrightarrow> groot_sym (ts'' ! i) = None"
         "i < length qs \<Longrightarrow> rs ! i = Some (qs ! i) \<Longrightarrow> ts'' ! i = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i)"
       for i using that Ex_list_of_length_P[of "length qs" ?P] by auto
       from  ts''(1, 3, 4) Some ps(2, 4) GFun(2) rs ts'(2-)
       have "map Some ts = (filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse ts''))"
       proof (induct ts'' arbitrary: qs rs ps ts rule: rev_induct)
         case (snoc a us)
         from snoc(2, 7) obtain r rs' where [simp]: "rs = rs' @ [r]"
           by (metis append_butlast_last_id append_is_Nil_conv length_0_conv not_Cons_self2)
         have l: "length us = length (butlast qs)" "length (butlast qs) = length (butlast rs)"
           using snoc(2, 7) by auto
         have *: "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = None \<Longrightarrow> groot_sym (us ! i) = None" for i
           using snoc(3)[of i] snoc(2, 7)
           by (auto simp:nth_append l(1) nth_butlast split!: if_splits)
         have **: "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = None \<or> butlast rs ! i = Some (butlast qs ! i)" for i
           using snoc(10)[of i] snoc(2, 7) l by (auto simp: nth_append nth_butlast)
         have "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = Some (butlast qs ! i) \<Longrightarrow>
            us ! i = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) (butlast rs) i)" for i
           using snoc(4)[of i] snoc(2, 7) l
           by (auto simp: nth_append nth_butlast filter_rev_nth_def take_butlast)
         note IH = snoc(1)[OF l(1) * this _ _ l(2) _ _ **]
         show ?case
         proof (cases "r = None")
           case True
           then have "map Some ts = filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse us)"
             using snoc(2, 5-)
             by (intro IH[of ps ts]) (auto simp: nth_append nth_butlast filter_rev_nth_butlast)
           then show ?thesis using True snoc(2, 7) snoc(3)[of "length (butlast rs)"]
             by (auto simp: nth_append l(1) last_nthI split!: if_splits)
         next
           case False
           then obtain t' ss where *: "ts = ss @ [t']" using snoc(2, 7, 8, 9)
             by (cases ts) (auto, metis append_butlast_last_id list.distinct(1))
           let ?i = "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs (length us)"
           have "map Some (butlast ts) = filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse us)"
             using False snoc(2, 5-) l filter_rev_nth_idx
             by (intro IH[of "butlast ps" "butlast ts"])
                (fastforce simp: nth_butlast filter_rev_nth_butlast)+
           moreover have "a = ts' ?i" "?i < length ps"
             using False snoc(2, 9) l snoc(4, 6, 10)[of "length us"]
             by (auto simp: nth_append)
           moreover have "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) (rs' @ [r]) (length rs') = length ss"
             using l snoc(2, 7, 8, 9) False unfolding *
             by (auto simp: filter_rev_nth_def)
           ultimately show ?thesis using l snoc(2, 7, 9) snoc(11-)[of ?i]
             by (auto simp: nth_append *)
         qed
       qed simp
       then have "ts = map the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts''))"
         by (metis comp_the_Some list.map_id map_map)
       then show ?case using ps(1, 2) ts''(1, 2) GFun(3)
         by (auto simp: collapse_automaton_def intro!: exI[of _ "GFun (Some f) ts''"] exI[of _ qs] exI[of _ p])
     qed
     then have "t \<in> the ` (gcollapse ` gta_lang Q A - {None})"
       by (meson Diff_iff gta_langI imageI q(1) singletonD)
   } moreover
   { fix t assume t: "t \<in> gta_lang Q A" "gcollapse t \<noteq> None"
     obtain q where q: "q |\<in>| Q" "q |\<in>| ta_der A (term_of_gterm t)" using t(1) by auto
     have "q |\<in>| ta_der (collapse_automaton A) (term_of_gterm (the (gcollapse t)))" using q(2) t(2)
     proof (induct t arbitrary: q)
       case (GFun f ts)
       obtain qs q' where q: "TA_rule f qs q' |\<in>| rules A" "q' = q \<or> (q', q) |\<in>| (eps (collapse_automaton A))|\<^sup>+|"
         "length qs = length ts" "\<And>i. i < length ts \<Longrightarrow> qs ! i |\<in>| ta_der A (term_of_gterm (ts ! i))"
         using GFun(2) by (auto simp: collapse_automaton_def)
       obtain f' where f [simp]: "f = Some f'" using GFun(3) by (cases f) auto
       define qs' where
         "qs' = map (\<lambda>i. if Option.is_none (gcollapse (ts ! i)) then None else Some (qs ! i)) [0..<length qs]"
       have "Option.is_none (gcollapse (ts ! i)) \<Longrightarrow> qs ! i |\<in>| Qn'" if "i < length qs" for i
         using q(4)[of i] that
         by (cases "ts ! i" rule: gcollapse.cases)
            (auto simp: q(3) Qn'_def collapse_Qn_Qs_set_conv)
       moreover have "\<not> Option.is_none (gcollapse (ts ! i)) \<Longrightarrow> qs ! i |\<in>| Qs'" if "i < length qs" for i
         using q(4)[of i] that
         by (cases "ts ! i" rule: gcollapse.cases)
            (auto simp: q(3) Qs'_def collapse_Qn_Qs_set_conv)
       ultimately have "f' (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) \<rightarrow> q' |\<in>| rules (collapse_automaton A)"
         using q(1, 4) unfolding collapse_automaton_def Qn'_def[symmetric] Qs'_def[symmetric]
         by (fastforce simp: qs'_def q(3) intro: exI[of _ qs] exI[of _ qs'] split: if_splits)
       moreover have ***: "length (filter (\<lambda>i.\<not> Option.is_none (gcollapse (ts ! i))) [0..<length ts]) =
         length (filter (\<lambda>t. \<not> Option.is_none (gcollapse t)) ts)" for ts
         by (subst length_map[of "(!) ts", symmetric] filter_map[unfolded comp_def, symmetric] map_nth)+
           (rule refl)
       note this[of ts]
       moreover have "the (filter (\<lambda>q. \<not> Option.is_none q) qs' ! i) |\<in>| ta_der (collapse_automaton A)
         (term_of_gterm (the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts) ! i)))"
         if "i < length [x\<leftarrow>ts . \<not> Option.is_none (gcollapse x)]" for i
         unfolding qs'_def using that q(3) GFun(1)[OF nth_mem q(4)]
       proof (induct ts arbitrary: qs rule: List.rev_induct)
         case (snoc t ts)
         have x1 [simp]: "i < length xs \<Longrightarrow> (xs @ ys) ! i = xs ! i" for xs ys i by (auto simp: nth_append)
         have x2: "i = length xs \<Longrightarrow> (xs @ ys) ! i = ys ! 0" for xs ys i by (auto simp: nth_append)
         obtain q qs' where qs [simp]: "qs = qs' @ [q]" using snoc(3) by (cases "rev qs") auto
         have [simp]:
           "map (\<lambda>x. if Option.is_none (gcollapse ((ts @ [t]) ! x)) then None else Some ((qs' @ [q]) ! x)) [0..<length ts] =
            map (\<lambda>x. if Option.is_none (gcollapse (ts ! x)) then None else Some (qs' ! x)) [0..<length ts]"
           using snoc(3) by auto
         show ?case
         proof (cases "Option.is_none (gcollapse t)")
           case True then show ?thesis using snoc(1)[of qs'] snoc(2,3)
             snoc(4)[unfolded length_append list.size add_0 add_0_right add_Suc_right, OF less_SucI]
             by (auto cong: if_cong)
         next
           case False note False' = this
           show ?thesis
           proof (cases "i = length [x\<leftarrow>ts . \<not> Option.is_none (gcollapse x)]")
             case True
             then show ?thesis using snoc(3) snoc(4)[of "length ts"]
               unfolding qs length_append list.size add_0 add_0_right add_Suc_right
                 upt_Suc_append[OF zero_le] filter_append map_append
               by (subst (5 6) x2) (auto simp: comp_def *** False' Option.is_none_def[symmetric])
           next
             case False
             then show ?thesis using snoc(1)[of qs'] snoc(2,3)
               snoc(4)[unfolded length_append list.size add_0 add_0_right add_Suc_right, OF less_SucI]
               unfolding qs length_append list.size add_0 add_0_right add_Suc_right
                 upt_Suc_append[OF zero_le] filter_append map_append
               by (subst (5 6) x1) (auto simp: comp_def *** False')
           qed
         qed
       qed auto
       ultimately show ?case using q(2) by (auto simp: qs'_def comp_def q(3)
         intro!: exI[of _ q'] exI[of _ "map the (filter (\<lambda>q. \<not> Option.is_none q) qs')"])
     qed
     then have "the (gcollapse t) \<in> gta_lang Q (collapse_automaton A)"
       by (metis q(1) gta_langI)
   } ultimately show ?thesis by blast
 qed
 
 lemma \<L>_collapse_automaton':
   assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" (* cf. ta_trim *)
   shows "\<L> (collapse_automaton_reg A) = the ` (gcollapse ` \<L> A - {None})"
   using assms by (auto simp: collapse_automaton_reg_def \<L>_def collapse_automaton')
 
 lemma collapse_automaton:
   assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" "RR1_spec A T"
   shows "RR1_spec (collapse_automaton_reg A) (the ` (gcollapse ` \<L> A - {None}))"
   using collapse_automaton'[OF assms(1)] assms(2)
   by (simp add: collapse_automaton_reg_def \<L>_def RR1_spec_def)
 
 
 subsection \<open>Cylindrification\<close>
 
 (* cylindrification is a product ("pairing") of a RR1 language accepting all terms, and an RRn language,
 modulo some fairly trivial renaming of symbols. *)
 
 definition pad_with_Nones where
   "pad_with_Nones n m = (\<lambda>(f, g). case_option (replicate n None) id f @ case_option (replicate m None) id g)"
 
 lemma gencode_append:
   "gencode (ss @ ts) = map_gterm (pad_with_Nones (length ss) (length ts)) (gpair (gencode ss) (gencode ts))"
 proof -
   have [simp]: "p \<notin> gposs (gunions (map gdomain ts)) \<Longrightarrow> map (\<lambda>t. gfun_at t p) ts = replicate (length ts) None"
     for p ts by (intro nth_equalityI) 
         (fastforce simp: poss_gposs_mem_conv fun_at_def' image_def all_set_conv_all_nth)+
   note [simp] = glabel_map_gterm_conv[of "\<lambda>(_ :: unit option). ()", unfolded comp_def gdomain_id]
   show ?thesis by (auto intro!: arg_cong[of _ _ "\<lambda>x. glabel x _"] simp del: gposs_gunions
     simp: pad_with_Nones_def gencode_def gunions_append gpair_def map_gterm_glabel comp_def)
 qed
 
 lemma append_automaton:
   assumes "RRn_spec n A T" "RRn_spec m B U"
   shows "RRn_spec (n + m) (fmap_funs_reg (pad_with_Nones n m) (pair_automaton_reg A B)) {ts @ us |ts us. ts \<in> T \<and> us \<in> U}"
   using assms pair_automaton[of A "gencode ` T" B "gencode ` U"]
   unfolding RRn_spec_def
 proof (intro conjI set_eqI iffI, goal_cases)
   case (1 s)
   then obtain ts us where "ts \<in> T" "us \<in> U" "s = gencode (ts @ us)"
     by (fastforce simp: \<L>_def fmap_funs_reg_def RR1_spec_def RR2_spec_def gencode_append fmap_funs_gta_lang)
   then show ?case by blast
 qed (fastforce simp: RR1_spec_def RR2_spec_def fmap_funs_reg_def \<L>_def gencode_append fmap_funs_gta_lang)+
 
 lemma cons_automaton:
   assumes "RR1_spec A T" "RRn_spec m B U"
   shows "RRn_spec (Suc m) (fmap_funs_reg (\<lambda>(f, g). pad_with_Nones 1 m (map_option (\<lambda>f. [Some f]) f, g))
    (pair_automaton_reg A B)) {t # us |t us. t \<in> T \<and> us \<in> U}"
 proof -
   have [simp]: "{ts @ us |ts us. ts \<in> (\<lambda>t. [t]) ` T \<and> us \<in> U} = {t # us |t us. t \<in> T \<and> us \<in> U}"
     by (auto intro: exI[of _ "[_]", OF exI])
   show ?thesis using append_automaton[OF RR1_to_RRn_spec, OF assms]
     by (auto simp: \<L>_def fmap_funs_reg_def pair_automaton_reg_def comp_def
       fmap_funs_gta_lang map_pair_automaton_12 fmap_funs_ta_comp prod.case_distrib
       gencode_append[of "[_]", unfolded gencode_singleton List.append.simps])
 qed
 
 subsection \<open>Projection\<close>
 
 (* projection is composed from fmap_funs_ta and collapse_automaton, corresponding to gsnd *)
 
 abbreviation "drop_none_rule m fs \<equiv> if list_all (Option.is_none) (drop m fs) then None else Some (drop m fs)"
 
 lemma drop_automaton_reg:
   assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" "m < n" "RRn_spec n A T"
   defines "f \<equiv> \<lambda>fs. drop_none_rule m fs"
   shows "RRn_spec (n - m) (collapse_automaton_reg (fmap_funs_reg f A)) (drop m ` T)"
 proof -
   have [simp]: "length ts = n - m ==> p \<in> gposs (gencode ts) \<Longrightarrow> \<exists>f. \<exists>t\<in>set ts. Some f = gfun_at t p" for p ts
   proof (cases p, goal_cases Empty PCons)
     case Empty
     obtain t where "t \<in> set ts" using assms(2) Empty(1) by (cases ts) auto
     moreover then obtain f where "Some f = gfun_at t p" using Empty(3) by (cases t rule: gterm.exhaust) auto
     ultimately show ?thesis by auto
   next
     case (PCons i p')
     then have "p \<noteq> []" by auto
     then show ?thesis using PCons(2)
       by (auto 0 3 simp: gencode_def eq_commute[of "gfun_at _ _" "Some _"] elim!: gfun_at_possE)
   qed
   { fix p ts y assume that: "gfun_at (gencode ts) p = Some y"
     have "p \<in> gposs (gencode ts) \<Longrightarrow> gfun_at (gencode ts) p = Some (map (\<lambda>t. gfun_at t p) ts)"
       by (auto simp: gencode_def)
     moreover have "gfun_at (gencode ts) p = Some y \<Longrightarrow> p \<in> gposs (gencode ts)"
       using gfun_at_nongposs by force
     ultimately have "y = map (\<lambda>t. gfun_at t p) ts \<and> p \<in> gposs (gencode ts)" by (simp add: that)
   } note [dest!] = this
   have [simp]: "list_all f (replicate n x) \<longleftrightarrow> n = 0 \<or> f x" for f n x by (induct n) auto
   have [dest]: "x \<in> set xs \<Longrightarrow> list_all f xs \<Longrightarrow> f x" for f x xs by (induct xs) auto
   have *: "f (pad_with_Nones m' n' z) = snd z"
     if  "fst z = None \<or> fst z \<noteq> None \<and> length (the (fst z)) = m"
       "snd z = None \<or> snd z \<noteq> None \<and> length (the (snd z)) = n - m \<and> (\<exists>y. Some y \<in> set (the (snd z)))"
       "m' = m" "n' = n - m" for z m' n'
     using that by (auto simp: f_def pad_with_Nones_def split: option.splits prod.splits)
   { fix ts assume ts: "ts \<in> T" "length ts = n"
     have "gencode (drop m ts) = the (gcollapse (map_gterm f (gencode ts)))"
       "gcollapse (map_gterm f (gencode ts)) \<noteq> None"
     proof (goal_cases)
       case 1 show ?case
         using ts assms(2)
         apply (subst gsnd_gpair[of "gencode (take m ts)", symmetric])
         apply (subst gencode_append[of "take m ts" "drop m ts", unfolded append_take_drop_id])
         unfolding gsnd_def comp_def gterm.map_comp
         apply (intro arg_cong[where f = "\<lambda>x. the (gcollapse x)"] gterm.map_cong refl)
         by (subst *) (auto simp: gpair_def set_gterm_gposs_conv image_def)
     next
       case 2
       have [simp]: "gcollapse t = None \<longleftrightarrow> gfun_at t [] = Some None" for t
         by (cases t rule: gcollapse.cases) auto
       obtain t where "t \<in> set (drop m ts)" using ts(2) assms(2) by (cases "drop m ts") auto
       moreover then have "\<not> Option.is_none (gfun_at t [])" by (cases t rule: gterm.exhaust) auto
       ultimately show ?case
         by (auto simp: f_def gencode_def list_all_def drop_map)
     qed
   }
   then show ?thesis using assms(3)
     by (fastforce simp: \<L>_def collapse_automaton_reg_def fmap_funs_reg_def
       RRn_spec_def fmap_funs_gta_lang gsnd_def gpair_def gterm.map_comp comp_def
       glabel_map_gterm_conv[unfolded comp_def] assms(1) collapse_automaton')
 qed
 
 lemma gfst_collapse_simp:
   "the (gcollapse (map_gterm fst t)) = gfst t"
   by (simp add: gfst_def)
 
 lemma gsnd_collapse_simp:
   "the (gcollapse (map_gterm snd t)) = gsnd t"
   by (simp add: gsnd_def)
 
 definition proj_1_reg where
   "proj_1_reg A = collapse_automaton_reg (fmap_funs_reg fst (trim_reg A))"
 definition proj_2_reg where
   "proj_2_reg A = collapse_automaton_reg (fmap_funs_reg snd (trim_reg A))"
 
 lemmas proj_1_reg_simp = proj_1_reg_def collapse_automaton_reg_def fmap_funs_reg_def trim_reg_def
 lemmas proj_2_reg_simp = proj_2_reg_def collapse_automaton_reg_def fmap_funs_reg_def trim_reg_def
 
 lemma \<L>_proj_1_reg_collapse:
   "\<L> (proj_1_reg \<A>) = the ` (gcollapse ` map_gterm fst ` (\<L> \<A>) - {None})"
 proof -
   have "\<Q>\<^sub>r (fmap_funs_reg fst (trim_reg \<A>)) |\<subseteq>| ta_reachable (ta (fmap_funs_reg fst (trim_reg \<A>)))"
     by (auto simp: fmap_funs_reg_def)
   note [simp] = \<L>_collapse_automaton'[OF this]
   show ?thesis by (auto simp: proj_1_reg_def fmap_funs_\<L> \<L>_trim)
 qed
 
 lemma \<L>_proj_2_reg_collapse:
   "\<L> (proj_2_reg \<A>) = the ` (gcollapse ` map_gterm snd ` (\<L> \<A>) - {None})"
 proof -
   have "\<Q>\<^sub>r (fmap_funs_reg snd (trim_reg \<A>)) |\<subseteq>| ta_reachable (ta (fmap_funs_reg snd (trim_reg \<A>)))"
     by (auto simp: fmap_funs_reg_def)
   note [simp] = \<L>_collapse_automaton'[OF this]
   show ?thesis by (auto simp: proj_2_reg_def fmap_funs_\<L> \<L>_trim)
 qed
 
 lemma proj_1:
   assumes "RR2_spec A R"
   shows "RR1_spec (proj_1_reg A) (fst ` R)"
 proof -
   {fix s t assume ass: "(s, t) \<in> R"
     from ass have s: "s = the (gcollapse (map_gterm fst (gpair s t)))"
       by (auto simp: gfst_gpair gfst_collapse_simp)
     then have "Some s = gcollapse (map_gterm fst (gpair s t))"
       by (cases s; cases t) (auto simp: gpair_def)
     then have "s \<in> \<L> (proj_1_reg A)" using assms ass s
       by (auto simp: proj_1_reg_simp \<L>_def trim_ta_reach trim_gta_lang
         image_def image_Collect RR2_spec_def fmap_funs_gta_lang
         collapse_automaton'[of "fmap_funs_ta fst (trim_ta (fin A) (ta A))"])
          force}
   moreover
   {fix s assume "s \<in> \<L> (proj_1_reg A)" then have "s \<in> fst ` R" using assms
       by (auto simp: gfst_collapse_simp gfst_gpair rev_image_eqI RR2_spec_def trim_ta_reach trim_gta_lang
         \<L>_def proj_1_reg_simp fmap_funs_gta_lang collapse_automaton'[of "fmap_funs_ta fst (trim_ta (fin A) (ta A))"])}
   ultimately show ?thesis using assms unfolding RR2_spec_def RR1_spec_def \<L>_def proj_1_reg_simp
     by auto
 qed
 
 lemma proj_2:
   assumes "RR2_spec A R"
   shows "RR1_spec (proj_2_reg A) (snd ` R)"
 proof -
   {fix s t assume ass: "(s, t) \<in> R"
     then have s: "t = the (gcollapse (map_gterm snd (gpair s t)))"
       by (auto simp: gsnd_gpair gsnd_collapse_simp)
     then have "Some t = gcollapse (map_gterm snd (gpair s t))"
       by (cases s; cases t) (auto simp: gpair_def)
     then have "t \<in> \<L> (proj_2_reg A)" using assms ass s
       by (auto simp: \<L>_def trim_ta_reach trim_gta_lang proj_2_reg_simp
         image_def image_Collect RR2_spec_def fmap_funs_gta_lang
         collapse_automaton'[of "fmap_funs_ta snd (trim_ta (fin A) (ta A))"])
         fastforce}
   moreover
   {fix s assume "s \<in> \<L> (proj_2_reg A)" then have "s \<in> snd ` R" using assms
       by (auto simp: \<L>_def gsnd_collapse_simp gsnd_gpair rev_image_eqI RR2_spec_def
         trim_ta_reach trim_gta_lang proj_2_reg_simp
         fmap_funs_gta_lang collapse_automaton'[of "fmap_funs_ta snd (trim_ta (fin A) (ta A))"])}
   ultimately show ?thesis using assms unfolding RR2_spec_def RR1_spec_def
     by auto
 qed
 
 lemma \<L>_proj:
   assumes "RR2_spec A R"
   shows "\<L> (proj_1_reg A) = gfst ` \<L> A" "\<L> (proj_2_reg A) = gsnd ` \<L> A"
 proof -
   have [simp]: "gfst ` {gpair t u |t u. (t, u) \<in> R} = fst ` R"
     by (force simp: gfst_gpair image_def)
   have [simp]: "gsnd ` {gpair t u |t u. (t, u) \<in> R} = snd ` R"
     by (force simp: gsnd_gpair image_def)
   show "\<L> (proj_1_reg A) = gfst ` \<L> A" "\<L> (proj_2_reg A) = gsnd ` \<L> A"
     using proj_1[OF assms] proj_2[OF assms] assms gfst_gpair gsnd_gpair
     by (auto simp: RR1_spec_def RR2_spec_def)
 qed
 
 lemmas proj_automaton_gta_lang = proj_1 proj_2
 
 subsection \<open>Permutation\<close>
 
 (* permutations are a direct application of fmap_funs_ta *)
 
 lemma gencode_permute:
   assumes "set ps = {0..<length ts}"
   shows "gencode (map ((!) ts) ps) = map_gterm (\<lambda>xs. map ((!) xs) ps) (gencode ts)"
 proof -
   have *: "(!) ts ` set ps = set ts" using assms by (auto simp: image_def set_conv_nth)
   show ?thesis using subsetD[OF equalityD1[OF assms]]
     apply (intro eq_gterm_by_gposs_gfun_at)
     unfolding gencode_def gposs_glabel gposs_map_gterm gposs_gunions gfun_at_map_gterm gfun_at_glabel
       set_map * by auto
 qed
 
 lemma permute_automaton:
   assumes "RRn_spec n A T" "set ps = {0..<n}"
   shows "RRn_spec (length ps) (fmap_funs_reg (\<lambda>xs. map ((!) xs) ps) A) ((\<lambda>xs. map ((!) xs) ps) ` T)"
   using assms by (auto simp: RRn_spec_def gencode_permute fmap_funs_reg_def \<L>_def fmap_funs_gta_lang image_def)
 
 
 subsection \<open>Intersection\<close>
 
 (* intersection is already defined in IsaFoR *)
 
 lemma intersect_automaton:
   assumes "RRn_spec n A T" "RRn_spec n B U"
   shows "RRn_spec n (reg_intersect A B) (T \<inter> U)" using assms
   by (simp add: RRn_spec_def \<L>_intersect)
      (metis gdecode_gencode image_Int inj_on_def)
 
 (*
 lemma swap_union_automaton:
   "fmap_states_ta (case_sum Inr Inl) (union_automaton B A) = union_automaton A B"
   by (simp add: fmap_states_ta_def' union_automaton_def image_Un image_comp case_sum_o_inj
     ta_rule.map_comp prod.map_comp comp_def id_def ac_simps)
 *)
 
 lemma union_automaton:
   assumes "RRn_spec n A T" "RRn_spec n B U"
   shows "RRn_spec n (reg_union A B) (T \<union> U)"
   using assms by (auto simp: RRn_spec_def \<L>_union)
 
 subsection \<open>Difference\<close>
 
 lemma RR1_difference:
   assumes "RR1_spec A T" "RR1_spec B U"
   shows "RR1_spec (difference_reg A B) (T - U)"
   using assms by (auto simp: RR1_spec_def \<L>_difference_reg)
 
 lemma RR2_difference:
   assumes "RR2_spec A T" "RR2_spec B U"
   shows "RR2_spec (difference_reg A B) (T - U)"
   using assms by (auto simp: RR2_spec_def \<L>_difference_reg)
 
 lemma RRn_difference:
   assumes "RRn_spec n A T" "RRn_spec n B U"
   shows "RRn_spec n (difference_reg A B) (T - U)"
   using assms by (auto simp: RRn_spec_def \<L>_difference_reg) (metis gdecode_gencode)+
 
 subsection \<open>All terms over a signature\<close>
 
 definition term_automaton :: "('f \<times> nat) fset \<Rightarrow> (unit, 'f) ta" where
   "term_automaton \<F> = TA ((\<lambda> (f, n). TA_rule f (replicate n ()) ()) |`| \<F>) {||}"
 definition term_reg where
   "term_reg \<F> = Reg {|()|} (term_automaton \<F>)"
 
 lemma term_automaton:
   "RR1_spec (term_reg \<F>) (\<T>\<^sub>G (fset \<F>))"
   unfolding RR1_spec_def gta_lang_def term_reg_def \<L>_def
 proof (intro set_eqI iffI, goal_cases lr rl)
   case (lr t)
   then have "() |\<in>| ta_der (term_automaton \<F>) (term_of_gterm t)"
     by (auto simp: gta_der_def)
   then show ?case
     by (induct t) (auto simp: term_automaton_def split: if_splits)
 next
   case (rl t)
   then have "() |\<in>| ta_der (term_automaton \<F>) (term_of_gterm t)"
   proof (induct t rule: \<T>\<^sub>G.induct)
     case (const a) then show ?case
       by (auto simp: term_automaton_def image_iff intro: bexI[of _ "(a, 0)"])
   next
     case (ind f n ss) then show ?case
       by (auto simp: term_automaton_def image_iff intro: bexI[of _ "(f, n)"])
   qed
   then show ?case
     by (auto simp: gta_der_def)
 qed
 
 fun true_RRn :: "('f \<times> nat) fset \<Rightarrow> nat \<Rightarrow> (nat, 'f option list) reg" where
   "true_RRn \<F> 0 = Reg {|0|} (TA {|TA_rule [] [] 0|} {||})"
 | "true_RRn \<F> (Suc 0) = relabel_reg (fmap_funs_reg (\<lambda>f. [Some f]) (term_reg \<F>))"
 | "true_RRn \<F> (Suc n) = relabel_reg
   (trim_reg (fmap_funs_reg (pad_with_Nones 1 n) (pair_automaton_reg (true_RRn \<F> 1) (true_RRn \<F> n))))"
 
 lemma true_RRn_spec:
   "RRn_spec n (true_RRn \<F> n) {ts. length ts = n \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)}"
 proof (induct \<F> n rule: true_RRn.induct)
   case (1 \<F>) show ?case
     by (simp cong: conj_cong add: true_RR0_spec)
 next
   case (2 \<F>)
   moreover have "{ts. length ts = 1 \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)} = (\<lambda>t. [t]) ` \<T>\<^sub>G (fset \<F>)"
     apply (intro equalityI subsetI)
     subgoal for ts by (cases ts) auto
     by auto
   ultimately show ?case
     using RR1_to_RRn_spec[OF term_automaton, of \<F>] by auto
 next
   case (3 \<F> n)
   have [simp]: "{ts @ us |ts us. length ts = n \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>) \<and> length us = m \<and>
     set us \<subseteq> \<T>\<^sub>G (fset \<F>)} = {ss. length ss = n + m \<and> set ss \<subseteq> \<T>\<^sub>G (fset \<F>)}" for n m
     by (auto 0 4 intro!: exI[of _ "take n _", OF exI[of _ "drop n _"], of _ xs xs for xs]
       dest!: subsetD[OF set_take_subset] subsetD[OF set_drop_subset])
   show ?case using append_automaton[OF 3]
     by simp
 qed
 
 
 subsection \<open>RR2 composition\<close>
 
 abbreviation "RR2_to_RRn A \<equiv> fmap_funs_reg (\<lambda>(f, g). [f, g]) A"
 abbreviation "RRn_to_RR2 A \<equiv> fmap_funs_reg (\<lambda>f. (f ! 0, f ! 1)) A"
 definition rr2_compositon where
   "rr2_compositon \<F> A B =
    (let A' = RR2_to_RRn A in
     let B' = RR2_to_RRn B in
     let F = true_RRn \<F> 1 in
     let CA = trim_reg (fmap_funs_reg (pad_with_Nones 2 1) (pair_automaton_reg A' F)) in
     let CB = trim_reg (fmap_funs_reg (pad_with_Nones 1 2) (pair_automaton_reg F B')) in
     let PI = trim_reg (fmap_funs_reg (\<lambda>xs. map ((!) xs) [1, 0, 2]) (reg_intersect CA CB)) in
     RRn_to_RR2 (collapse_automaton_reg (fmap_funs_reg (drop_none_rule 1) PI))
    )"
 
 lemma list_length1E:
   assumes "length xs = Suc 0" obtains x where "xs = [x]" using assms
   by (cases xs) auto
 
 lemma rr2_compositon:
   assumes "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" "\<LL> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)"
     and "RR2_spec A \<R>" and "RR2_spec B \<LL>"
   shows "RR2_spec (rr2_compositon \<F> A B) (\<R> O \<LL>)"
 proof -
   let ?R = "(\<lambda>(t, u). [t, u]) ` \<R>" let ?L = "(\<lambda>(t, u). [t, u]) ` \<LL>"
   let ?A = "RR2_to_RRn A" let ?B = "RR2_to_RRn B" let ?F = "true_RRn \<F> 1"
   let ?CA = "trim_reg (fmap_funs_reg (pad_with_Nones 2 1) (pair_automaton_reg ?A ?F))"
   let ?CB = "trim_reg (fmap_funs_reg (pad_with_Nones 1 2) (pair_automaton_reg ?F ?B))"
   let ?PI = "trim_reg (fmap_funs_reg (\<lambda>xs. map ((!) xs) [1, 0, 2]) (reg_intersect ?CA ?CB))"
   let ?DR = "collapse_automaton_reg (fmap_funs_reg (drop_none_rule 1) ?PI)"
   let ?Rs = "{ts @ us | ts us. ts \<in> ?R \<and> (\<exists>t. us = [t] \<and> t \<in> \<T>\<^sub>G (fset \<F>))}"
   let ?Ls = "{us @ ts | ts us. ts \<in> ?L \<and> (\<exists>t. us = [t] \<and> t \<in> \<T>\<^sub>G (fset \<F>))}"
   from RR2_to_RRn_spec assms(3, 4)
   have rr2: "RRn_spec 2 ?A ?R" "RRn_spec 2 ?B ?L" by auto
   have *: "{ts. length ts = 1 \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)} = {[t] | t. t \<in> \<T>\<^sub>G (fset \<F>)}"
     by (auto elim!: list_length1E)
   have F: "RRn_spec 1 ?F {[t] | t. t \<in> \<T>\<^sub>G (fset \<F>)}" using true_RRn_spec[of 1 \<F>] unfolding * .
   have "RRn_spec 3 ?CA ?Rs" "RRn_spec 3 ?CB ?Ls"
     using append_automaton[OF rr2(1) F] append_automaton[OF F rr2(2)]
     by (auto simp: numeral_3_eq_3) (smt Collect_cong)
   from permute_automaton[OF intersect_automaton[OF this], of "[1, 0, 2]"]
   have "RRn_spec 3 ?PI ((\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls))"
     by (auto simp: atLeast0_lessThan_Suc insert_commute numeral_2_eq_2 numeral_3_eq_3)
   from drop_automaton_reg[OF _ _ this, of 1]
   have sp: "RRn_spec 2 ?DR (drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls))"
     by auto
   {fix s assume "s \<in> (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)"
     then obtain t u v where comp: "s = [t, u]" "(t, v) \<in> \<R>" "(v, u) \<in> \<LL>"
       by (auto simp: image_iff relcomp_unfold split!: prod.split)
     then have "[t, v] \<in> ?R" "[v , u] \<in> ?L" "u \<in> \<T>\<^sub>G (fset \<F>)" "v \<in> \<T>\<^sub>G (fset \<F>)" "t \<in> \<T>\<^sub>G (fset \<F>)" using assms(1, 2)
       by (auto simp: image_iff relcomp_unfold split!: prod.splits)
     then have "[t, v, u] \<in> ?Rs" "[t, v, u] \<in> ?Ls"
       apply (simp_all)
       subgoal
         apply (rule exI[of _ "[t, v]"], rule exI[of _ "[u]"])
         apply simp
         done
       subgoal
         apply (rule exI[of _ "[v, u]"], rule exI[of _ "[t]"])
         apply simp
         done
       done
     then have "s \<in> drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls)" unfolding comp(1)
       apply (simp add: image_def Bex_def)
       apply (rule exI[of _ "[v, t, u]"]) apply simp
       apply (rule exI[of _ "[t, v, u]"]) apply simp
       done}
   moreover have "drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls) \<subseteq> (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)"
     by (auto simp: image_iff relcomp_unfold Bex_def split!: prod.splits)
   ultimately have *: "drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls) = (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)"
     by (simp add: subsetI subset_antisym)
   have **: "(\<lambda>f. (f ! 0, f ! 1)) ` (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>) = \<R> O \<LL>"
     by (force simp: image_def relcomp_unfold split!: prod.splits)
   show ?thesis using sp unfolding *
     using RRn_to_RR2_spec[where ?T = "(\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)" and ?A = ?DR]
     unfolding ** by (auto simp: rr2_compositon_def Let_def image_iff)
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy
--- a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy
+++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy
@@ -1,2191 +1,2192 @@
 section \<open>Tree automaton\<close>
 
 theory Tree_Automata
   imports FSet_Utils
     "HOL-Library.Product_Lexorder"
     "HOL-Library.Option_ord"
 begin
 
 subsection \<open>Tree automaton definition and functionality\<close>
 
 datatype ('q, 'f) ta_rule = TA_rule (r_root: 'f) (r_lhs_states: "'q list") (r_rhs: 'q) ("_ _ \<rightarrow> _" [51, 51, 51] 52)
 datatype ('q, 'f) ta = TA (rules: "('q, 'f) ta_rule fset") (eps: "('q \<times> 'q) fset")
 
 text \<open>In many application we are interested in specific subset of all terms. If these
   can be captured by a tree automaton (identified by a state) then we say the set is regular.
   This gives the motivation for the following definition\<close>
 datatype ('q, 'f) reg = Reg (fin: "'q fset") (ta: "('q, 'f) ta")
 
 
 text \<open>The state set induced by a tree automaton is implicit in our representation.
   We compute it based on the rules and epsilon transitions of a given tree automaton\<close>
 
 abbreviation rule_arg_states where "rule_arg_states \<Delta> \<equiv> |\<Union>| ((fset_of_list \<circ> r_lhs_states) |`| \<Delta>)"
 abbreviation rule_target_states where "rule_target_states \<Delta> \<equiv> (r_rhs |`| \<Delta>)"
 definition rule_states where "rule_states \<Delta> \<equiv> rule_arg_states \<Delta> |\<union>| rule_target_states \<Delta>"
 
 definition eps_states where "eps_states \<Delta>\<^sub>\<epsilon> \<equiv> (fst |`| \<Delta>\<^sub>\<epsilon>) |\<union>| (snd |`| \<Delta>\<^sub>\<epsilon>)"
 definition "\<Q> \<A> = rule_states (rules \<A>) |\<union>| eps_states (eps \<A>)"
 abbreviation "\<Q>\<^sub>r \<A> \<equiv> \<Q> (ta \<A>)"
 
 definition ta_rhs_states :: "('q, 'f) ta \<Rightarrow> 'q fset" where
   "ta_rhs_states \<A> \<equiv> {| q | p q. (p |\<in>| rule_target_states (rules \<A>)) \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)|}"
 
 definition "ta_sig \<A> = (\<lambda> r. (r_root r, length (r_lhs_states r))) |`| (rules \<A>)"
 
 subsubsection \<open>Rechability of a term induced by a tree automaton\<close>
 (* The reachable states of some term. *)
 fun ta_der :: "('q, 'f) ta \<Rightarrow> ('f, 'q) term \<Rightarrow> 'q fset" where
   "ta_der \<A> (Var q) = {|q' | q'. q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+| |}"
 | "ta_der \<A> (Fun f ts) = {|q' | q' q qs.
     TA_rule f qs q |\<in>| (rules \<A>) \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|) \<and> length qs = length ts \<and> 
     (\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i))|}"
 
 (* The reachable mixed terms of some term. *)
 fun ta_der' :: "('q,'f) ta \<Rightarrow> ('f,'q) term \<Rightarrow> ('f,'q) term fset" where
   "ta_der' \<A> (Var p) = {|Var q | q. p = q \<or>  (p, q) |\<in>| (eps \<A>)|\<^sup>+| |}"
 | "ta_der' \<A> (Fun f ts) = {|Var q | q. q |\<in>| ta_der \<A> (Fun f ts)|} |\<union>|
     {|Fun f ss | ss. length ss = length ts \<and>
       (\<forall>i < length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i))|}"
 
 text \<open>Sometimes it is useful to analyse a concrete computation done by a tree automaton.
   To do this we introduce the notion of run which keeps track which states are computed in each
   subterm to reach a certain state.\<close>
 
 abbreviation "ex_rule_state \<equiv> fst \<circ> groot_sym"
 abbreviation "ex_comp_state \<equiv> snd \<circ> groot_sym"
 
 inductive run for \<A> where
   step: "length qs = length ts \<Longrightarrow> (\<forall> i < length ts. run \<A> (qs ! i) (ts ! i)) \<Longrightarrow>
     TA_rule f (map ex_comp_state qs) q |\<in>| (rules \<A>) \<Longrightarrow> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|) \<Longrightarrow> 
     run \<A> (GFun (q, q') qs) (GFun f ts)"
 
 
 subsubsection \<open>Language acceptance\<close>
 
 definition ta_lang :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('f, 'v) terms" where
   [code del]: "ta_lang Q \<A> = {adapt_vars t | t. ground t \<and> Q |\<inter>| ta_der \<A> t \<noteq> {||}}"
 
 definition gta_der where
   "gta_der \<A> t = ta_der \<A> (term_of_gterm t)"
 
 definition gta_lang where
   "gta_lang Q \<A> = {t. Q |\<inter>| gta_der \<A> t \<noteq> {||}}"
 
 definition \<L> where
   "\<L> \<A> = gta_lang (fin \<A>) (ta \<A>)"
 
 definition reg_Restr_Q\<^sub>f where
   "reg_Restr_Q\<^sub>f R = Reg (fin R |\<inter>| \<Q>\<^sub>r R) (ta R)"
 
 subsubsection \<open>Trimming\<close>
 
 definition ta_restrict where
   "ta_restrict \<A> Q = TA {| TA_rule f qs q| f qs q. TA_rule f qs q |\<in>| rules \<A> \<and> fset_of_list qs |\<subseteq>| Q \<and> q |\<in>| Q |} (fRestr (eps \<A>) Q)"
 
 definition ta_reachable :: "('q, 'f) ta \<Rightarrow> 'q fset" where
   "ta_reachable \<A> = {|q| q. \<exists> t. ground t \<and> q |\<in>| ta_der \<A> t |}"
 
 definition ta_productive :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> 'q fset" where
   "ta_productive P \<A> \<equiv> {|q| q q' C. q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| P |}"
 
 text \<open>An automaton is trim if all its states are reachable and productive.\<close>
 definition ta_is_trim :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> bool" where
   "ta_is_trim P \<A> \<equiv> \<forall> q. q |\<in>| \<Q> \<A> \<longrightarrow> q |\<in>| ta_reachable \<A> \<and> q |\<in>| ta_productive P \<A>"
 
 definition reg_is_trim :: "('q, 'f) reg \<Rightarrow> bool" where
   "reg_is_trim R \<equiv> ta_is_trim (fin R) (ta R)"
 
 text \<open>We obtain a trim automaton by restriction it to reachable and productive states.\<close>
 abbreviation ta_only_reach :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where
   "ta_only_reach \<A> \<equiv> ta_restrict \<A> (ta_reachable \<A>)"
 
 abbreviation ta_only_prod :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> ('q,'f) ta" where
   "ta_only_prod P \<A> \<equiv> ta_restrict \<A> (ta_productive P \<A>)"
 
 definition reg_reach where
   "reg_reach R = Reg (fin R) (ta_only_reach (ta R))"
 
 definition reg_prod where
   "reg_prod R = Reg (fin R) (ta_only_prod (fin R) (ta R))"
 
 definition trim_ta :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where
   "trim_ta P \<A> = ta_only_prod P (ta_only_reach \<A>)"
 
 definition trim_reg where
   "trim_reg R = Reg (fin R) (trim_ta (fin R) (ta R))"
 
 subsubsection \<open>Mapping over tree automata\<close>
 
 definition fmap_states_ta ::  "('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'f) ta \<Rightarrow> ('b, 'f) ta" where
   "fmap_states_ta f \<A> = TA (map_ta_rule f id |`| rules \<A>) (map_both f |`| eps \<A>)"
 
 definition fmap_funs_ta :: "('f \<Rightarrow> 'g) \<Rightarrow> ('a, 'f) ta \<Rightarrow> ('a, 'g) ta" where
   "fmap_funs_ta f \<A> = TA (map_ta_rule id f |`| rules \<A>) (eps \<A>)"
 
 definition fmap_states_reg ::  "('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'f) reg \<Rightarrow> ('b, 'f) reg" where
   "fmap_states_reg f R = Reg (f |`| fin R) (fmap_states_ta f (ta R))"
 
 definition fmap_funs_reg :: "('f \<Rightarrow> 'g) \<Rightarrow> ('a, 'f) reg \<Rightarrow> ('a, 'g) reg" where
   "fmap_funs_reg f R = Reg (fin R) (fmap_funs_ta f (ta R))"
 
 subsubsection \<open>Product construction (language intersection)\<close>
 
 definition prod_ta_rules :: "('q1,'f) ta \<Rightarrow> ('q2,'f) ta \<Rightarrow> ('q1 \<times> 'q2, 'f) ta_rule fset" where
   "prod_ta_rules \<A> \<B> = {| TA_rule f qs q | f qs q. TA_rule f (map fst qs) (fst q) |\<in>| rules \<A> \<and>
      TA_rule f (map snd qs) (snd q) |\<in>| rules \<B>|}"
 declare prod_ta_rules_def [simp]
 
 
 definition prod_epsLp where
   "prod_epsLp \<A> \<B> = (\<lambda> (p, q). (fst p, fst q) |\<in>| eps \<A> \<and> snd p = snd q \<and> snd q |\<in>| \<Q> \<B>)"
 definition prod_epsRp where
   "prod_epsRp \<A> \<B> = (\<lambda> (p, q). (snd p, snd q) |\<in>| eps \<B> \<and> fst p = fst q \<and> fst q |\<in>| \<Q> \<A>)"
 
 definition prod_ta :: "('q1,'f) ta \<Rightarrow> ('q2,'f) ta \<Rightarrow> ('q1 \<times> 'q2, 'f) ta" where
   "prod_ta \<A> \<B> = TA (prod_ta_rules \<A> \<B>)
     (fCollect (prod_epsLp \<A> \<B>) |\<union>| fCollect (prod_epsRp \<A> \<B>))"
 
 definition reg_intersect where
   "reg_intersect R L = Reg (fin R |\<times>| fin L) (prod_ta (ta R) (ta L))"
 
 subsubsection \<open>Union construction (language union)\<close>
 
 definition ta_union where
   "ta_union \<A> \<B> = TA (rules \<A> |\<union>| rules \<B>) (eps \<A> |\<union>| eps \<B>)"
 
 definition reg_union where
   "reg_union R L = Reg (Inl |`| (fin R |\<inter>| \<Q>\<^sub>r R) |\<union>| Inr |`| (fin L |\<inter>| \<Q>\<^sub>r L))
     (ta_union (fmap_states_ta Inl (ta R)) (fmap_states_ta Inr (ta L)))"
 
 
 subsubsection \<open>Epsilon free and tree automaton accepting empty language\<close>
 
 definition eps_free_rulep where
   "eps_free_rulep \<A> = (\<lambda> r. \<exists> f qs q q'. r = TA_rule f qs q' \<and> TA_rule f qs q |\<in>| rules \<A> \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|))"
 
 definition eps_free :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where
   "eps_free \<A> = TA (fCollect (eps_free_rulep \<A>)) {||}"
 
 definition is_ta_eps_free :: "('q, 'f) ta \<Rightarrow> bool" where
   "is_ta_eps_free \<A> \<longleftrightarrow> eps \<A> = {||}"
 
 definition ta_empty :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> bool" where
   "ta_empty Q \<A> \<longleftrightarrow> ta_reachable \<A> |\<inter>| Q |\<subseteq>| {||}"
 
 definition eps_free_reg where
   "eps_free_reg R = Reg (fin R) (eps_free (ta R))"
 
 definition reg_empty where
   "reg_empty R = ta_empty (fin R) (ta R)"
 
 
 subsubsection \<open>Relabeling tree automaton states to natural numbers\<close>
 
 definition map_fset_to_nat :: "('a :: linorder) fset \<Rightarrow> 'a \<Rightarrow> nat" where
   "map_fset_to_nat X = (\<lambda>x. the (mem_idx x (sorted_list_of_fset X)))"
 
 definition map_fset_fset_to_nat :: "('a :: linorder) fset fset \<Rightarrow> 'a fset \<Rightarrow> nat" where
   "map_fset_fset_to_nat X = (\<lambda>x. the (mem_idx (sorted_list_of_fset x) (sorted_list_of_fset (sorted_list_of_fset |`| X))))"
 
 definition relabel_ta :: "('q :: linorder, 'f) ta \<Rightarrow> (nat, 'f) ta" where
   "relabel_ta \<A> = fmap_states_ta (map_fset_to_nat (\<Q> \<A>)) \<A>"
 
 definition relabel_Q\<^sub>f :: "('q :: linorder) fset \<Rightarrow> ('q :: linorder, 'f) ta \<Rightarrow> nat fset" where
   "relabel_Q\<^sub>f Q \<A> = map_fset_to_nat (\<Q> \<A>) |`| (Q |\<inter>| \<Q> \<A>)"
 definition relabel_reg  :: "('q :: linorder, 'f) reg \<Rightarrow> (nat, 'f) reg" where
   "relabel_reg R = Reg (relabel_Q\<^sub>f (fin R) (ta R)) (relabel_ta (ta R))"
 
 \<comment> \<open>The instantiation of $<$ and $\leq$ for finite sets are $\mid \subset \mid$ and $\mid \subseteq \mid$
   which don't give rise to a total order and therefore it cannot be an instance of the type class linorder.
   However taking the lexographic order of the sorted list of each finite set gives rise
   to a total order. Therefore we provide a relabeling for tree automata where the states
   are finite sets. This allows us to relabel the well known power set construction.\<close>
 
 definition relabel_fset_ta :: "(('q :: linorder) fset, 'f) ta \<Rightarrow> (nat, 'f) ta" where
   "relabel_fset_ta \<A> = fmap_states_ta (map_fset_fset_to_nat (\<Q> \<A>)) \<A>"
 
 definition relabel_fset_Q\<^sub>f :: "('q :: linorder) fset fset \<Rightarrow> (('q :: linorder) fset, 'f) ta \<Rightarrow> nat fset" where
   "relabel_fset_Q\<^sub>f Q \<A> = map_fset_fset_to_nat (\<Q> \<A>) |`| (Q |\<inter>| \<Q> \<A>)"
 
 definition relable_fset_reg  :: "(('q :: linorder) fset, 'f) reg \<Rightarrow> (nat, 'f) reg" where
   "relable_fset_reg R = Reg (relabel_fset_Q\<^sub>f (fin R) (ta R)) (relabel_fset_ta (ta R))"
 
 
 definition "srules \<A> = fset (rules \<A>)"
 definition "seps \<A> = fset (eps \<A>)"
 
 lemma rules_transfer [transfer_rule]:
   "rel_fun (=) (pcr_fset (=)) srules rules" unfolding rel_fun_def
   by (auto simp add: cr_fset_def fset.pcr_cr_eq srules_def)
 
 lemma eps_transfer [transfer_rule]:
   "rel_fun (=) (pcr_fset (=)) seps eps" unfolding rel_fun_def
   by (auto simp add: cr_fset_def fset.pcr_cr_eq seps_def)
 
 lemma TA_equalityI:
   "rules \<A> = rules \<B> \<Longrightarrow> eps \<A> = eps \<B> \<Longrightarrow> \<A> = \<B>"
   using ta.expand by blast
 
 lemma rule_states_code [code]:
   "rule_states \<Delta> = |\<Union>| ((\<lambda> r. finsert (r_rhs r) (fset_of_list (r_lhs_states r))) |`| \<Delta>)"
   unfolding rule_states_def
   by fastforce
 
 lemma eps_states_code [code]:
   "eps_states \<Delta>\<^sub>\<epsilon> = |\<Union>| ((\<lambda> (q,q'). {|q,q'|}) |`| \<Delta>\<^sub>\<epsilon>)" (is "?Ls = ?Rs")
   unfolding eps_states_def
   by (force simp add: case_prod_beta')
 
 lemma rule_states_empty [simp]:
   "rule_states {||} = {||}"
   by (auto simp: rule_states_def)
 
 lemma eps_states_empty [simp]:
   "eps_states {||} = {||}"
   by (auto simp: eps_states_def)
 
 lemma rule_states_union [simp]:
   "rule_states (\<Delta> |\<union>| \<Gamma>) = rule_states \<Delta> |\<union>| rule_states \<Gamma>"
   unfolding rule_states_def
   by fastforce
 
 lemma rule_states_mono:
   "\<Delta> |\<subseteq>| \<Gamma> \<Longrightarrow> rule_states \<Delta> |\<subseteq>| rule_states \<Gamma>"
   unfolding rule_states_def
   by force
 
 lemma eps_states_union [simp]:
   "eps_states (\<Delta> |\<union>| \<Gamma>) = eps_states \<Delta> |\<union>| eps_states \<Gamma>"
   unfolding eps_states_def
   by auto
 
 lemma eps_states_image [simp]:
   "eps_states (map_both f |`| \<Delta>\<^sub>\<epsilon>) = f |`| eps_states \<Delta>\<^sub>\<epsilon>"
   unfolding eps_states_def map_prod_def
   by (force simp: fimage_iff)
 
 lemma eps_states_mono:
   "\<Delta> |\<subseteq>| \<Gamma> \<Longrightarrow> eps_states \<Delta> |\<subseteq>| eps_states \<Gamma>"
   unfolding eps_states_def
   by transfer auto
 
 lemma eps_statesI [intro]:
   "(p, q) |\<in>| \<Delta> \<Longrightarrow> p |\<in>| eps_states \<Delta>"
   "(p, q) |\<in>| \<Delta> \<Longrightarrow> q |\<in>| eps_states \<Delta>"
   unfolding eps_states_def
   by (auto simp add: rev_image_eqI)
 
 lemma eps_statesE [elim]:
   assumes "p |\<in>| eps_states \<Delta>"
   obtains q where "(p, q) |\<in>| \<Delta> \<or> (q, p) |\<in>| \<Delta>" using assms
   unfolding eps_states_def
   by (transfer, auto)+
 
 lemma rule_statesE [elim]:
   assumes "q |\<in>| rule_states \<Delta>"
   obtains f ps p where "TA_rule f ps p |\<in>| \<Delta>" "q |\<in>| (fset_of_list ps) \<or> q = p" using assms
 proof -
   assume ass: "(\<And>f ps p. f ps \<rightarrow> p |\<in>| \<Delta> \<Longrightarrow> q |\<in>| fset_of_list ps \<or> q = p \<Longrightarrow> thesis)"
   from assms obtain r where "r |\<in>| \<Delta>" "q |\<in>| fset_of_list (r_lhs_states r) \<or> q = r_rhs r"
     by (auto simp: rule_states_def)
   then show thesis using ass
     by (cases r) auto
 qed
 
 lemma rule_statesI [intro]:
   assumes "r |\<in>| \<Delta>" "q |\<in>| finsert (r_rhs r) (fset_of_list (r_lhs_states r))"
   shows "q |\<in>| rule_states \<Delta>" using assms
   by (auto simp: rule_states_def)
 
 
 text \<open>Destruction rule for states\<close>
 
 lemma rule_statesD:
   "r |\<in>| (rules \<A>) \<Longrightarrow> r_rhs r |\<in>| \<Q> \<A>" "f qs \<rightarrow> q |\<in>| (rules \<A>) \<Longrightarrow> q |\<in>| \<Q> \<A>"
   "r |\<in>| (rules \<A>) \<Longrightarrow> p |\<in>| fset_of_list (r_lhs_states r) \<Longrightarrow> p |\<in>| \<Q> \<A>"
   "f qs \<rightarrow> q |\<in>| (rules \<A>) \<Longrightarrow> p |\<in>| fset_of_list qs \<Longrightarrow> p |\<in>| \<Q> \<A>"
   by (force simp: \<Q>_def rule_states_def fimage_iff)+
 
 lemma eps_states [simp]: "(eps \<A>) |\<subseteq>| \<Q> \<A> |\<times>| \<Q> \<A>"
   unfolding \<Q>_def eps_states_def rule_states_def
   by (auto simp add: rev_image_eqI)
 
 lemma eps_statesD: "(p, q) |\<in>| (eps \<A>) \<Longrightarrow> p |\<in>| \<Q> \<A> \<and> q |\<in>| \<Q> \<A>"
   using eps_states by (auto simp add: \<Q>_def)
 
 lemma eps_trancl_statesD:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> p |\<in>| \<Q> \<A> \<and> q |\<in>| \<Q> \<A>"
   by (induct rule: ftrancl_induct) (auto dest: eps_statesD)
 
 lemmas eps_dest_all = eps_statesD eps_trancl_statesD
 
 text \<open>Mapping over function symbols/states\<close>
 
 lemma finite_Collect_ta_rule:
   "finite {TA_rule f qs q | f qs q. TA_rule f qs q |\<in>| rules \<A>}" (is "finite ?S")
 proof -
   have "{f qs \<rightarrow> q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>} \<subseteq> fset (rules \<A>)"
     by auto
   from finite_subset[OF this] show ?thesis by simp
 qed
 
 lemma map_ta_rule_finite:
   "finite \<Delta> \<Longrightarrow> finite {TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q \<in> \<Delta>}"
 proof (induct rule: finite.induct)
   case (insertI A a)
   have union: "{TA_rule (g h) (map f qs) (f q) |h qs q. TA_rule h qs q \<in> insert a A} =
     {TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q = a} \<union> {TA_rule (g h) (map f qs) (f q) |h qs q. TA_rule h qs q \<in> A}"
     by auto
   have "finite {g h map f qs \<rightarrow> f q |h qs q. h qs \<rightarrow> q = a}"
     by (cases a) auto
   from finite_UnI[OF this insertI(2)] show ?case unfolding union .
 qed auto
 
 lemmas map_ta_rule_fset_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" for \<Delta>, simplified]
 lemmas map_ta_rule_states_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" id for \<Delta>, simplified]
 lemmas map_ta_rule_funsym_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" _ id for \<Delta>, simplified]
 
 lemma map_ta_rule_comp:
   "map_ta_rule f g \<circ> map_ta_rule f' g' = map_ta_rule (f \<circ> f') (g \<circ> g')"
   using ta_rule.map_comp[of f g]
   by (auto simp: comp_def)
 
 lemma map_ta_rule_cases:
   "map_ta_rule f g r = TA_rule (g (r_root r)) (map f (r_lhs_states r)) (f (r_rhs r))"
   by (cases r) auto
 
 lemma map_ta_rule_prod_swap_id [simp]:
   "map_ta_rule prod.swap prod.swap (map_ta_rule prod.swap prod.swap r) = r"
   by (auto simp: map_ta_rule_cases)
 
 
 lemma rule_states_image [simp]:
   "rule_states (map_ta_rule f g |`| \<Delta>) = f |`| rule_states \<Delta>" (is "?Ls = ?Rs")
 proof -
   {fix q assume "q |\<in>| ?Ls"
     then obtain r where "r |\<in>| \<Delta>"
       "q |\<in>| finsert (r_rhs (map_ta_rule f g r)) (fset_of_list (r_lhs_states (map_ta_rule f g r)))"
       by (auto simp: rule_states_def)
     then have "q |\<in>| ?Rs" by (cases r) (force simp: fimage_iff)}
   moreover
   {fix q assume "q |\<in>| ?Rs"
     then obtain r p where "r |\<in>| \<Delta>" "f p = q"
       "p |\<in>| finsert (r_rhs r) (fset_of_list (r_lhs_states r))"
       by (auto simp: rule_states_def)
     then have "q |\<in>| ?Ls" by (cases r) (force simp: fimage_iff)}
   ultimately show ?thesis by blast
 qed
 
 lemma \<Q>_mono:
   "(rules \<A>) |\<subseteq>| (rules \<B>) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \<B>) \<Longrightarrow> \<Q> \<A> |\<subseteq>| \<Q> \<B>"
   using rule_states_mono eps_states_mono unfolding \<Q>_def
   by blast
 
 lemma \<Q>_subseteq_I:
   assumes "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> r_rhs r |\<in>| S"
     and "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> fset_of_list (r_lhs_states r) |\<subseteq>| S"
     and "\<And> e. e |\<in>| eps \<A> \<Longrightarrow> fst e |\<in>| S \<and> snd e |\<in>| S"
   shows "\<Q> \<A> |\<subseteq>| S" using assms unfolding \<Q>_def
   by (auto simp: rule_states_def) blast
 
 lemma finite_states:
   "finite {q. \<exists> f p ps. f ps \<rightarrow> p |\<in>| rules \<A> \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?set")
 proof -
   have "?set \<subseteq> fset (\<Q> \<A>)"
     by (intro subsetI, drule CollectD)
        (metis eps_trancl_statesD rule_statesD(2))
   from finite_subset[OF this] show ?thesis by auto
 qed
 
 text \<open>Collecting all states reachable from target of rules\<close>
 
 lemma finite_ta_rhs_states [simp]:
   "finite {q. \<exists>p. p |\<in>| rule_target_states (rules \<A>) \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?Set")
 proof -
   have "?Set \<subseteq> fset (\<Q> \<A>)"
     by (auto dest: rule_statesD)
        (metis eps_trancl_statesD rule_statesD(1))+
   from finite_subset[OF this] show ?thesis
     by auto
 qed
 
 text \<open>Computing the signature induced by the rule set of given tree automaton\<close>
 
 
 
 lemma ta_sigI [intro]:
   "TA_rule f qs q |\<in>| (rules \<A>) \<Longrightarrow> length qs = n \<Longrightarrow> (f, n) |\<in>| ta_sig \<A>" unfolding ta_sig_def
   using mk_disjoint_finsert by fastforce
 
 lemma ta_sig_mono:
   "(rules \<A>) |\<subseteq>| (rules \<B>) \<Longrightarrow> ta_sig \<A> |\<subseteq>| ta_sig \<B>"
   by (auto simp: ta_sig_def)
 
 lemma finite_eps:
   "finite {q. \<exists> f ps p. f ps \<rightarrow> p |\<in>| rules \<A> \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?S")
   by (intro finite_subset[OF _ finite_ta_rhs_states[of \<A>]]) (auto intro!: bexI)
 
 lemma collect_snd_trancl_fset:
   "{p. (q, p) |\<in>| (eps \<A>)|\<^sup>+|} = fset (snd |`| (ffilter (\<lambda> x. fst x = q) ((eps \<A>)|\<^sup>+|)))"
   by (auto simp: image_iff) force
 
 lemma ta_der_Var:
   "q |\<in>| ta_der \<A> (Var x) \<longleftrightarrow> x = q \<or> (x, q) |\<in>| (eps \<A>)|\<^sup>+|"
   by (auto simp: collect_snd_trancl_fset)
 
 lemma ta_der_Fun:
   "q |\<in>| ta_der \<A> (Fun f ts) \<longleftrightarrow> (\<exists> ps p. TA_rule f ps p |\<in>| (rules \<A>) \<and>
       (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|) \<and> length ps = length ts \<and> 
       (\<forall> i < length ts. ps ! i |\<in>| ta_der \<A> (ts ! i)))" (is "?Ls \<longleftrightarrow> ?Rs")
   unfolding ta_der.simps
   by (intro iffI fCollect_memberI finite_Collect_less_eq[OF _ finite_eps[of \<A>]]) auto
 
 declare ta_der.simps[simp del]
 declare ta_der.simps[code del]
 lemmas ta_der_simps [simp] = ta_der_Var ta_der_Fun
 
 lemma ta_der'_Var:
   "Var q |\<in>| ta_der' \<A> (Var x) \<longleftrightarrow> x = q \<or> (x, q) |\<in>| (eps \<A>)|\<^sup>+|"
   by (auto simp: collect_snd_trancl_fset)
 
 lemma ta_der'_Fun:
   "Var q |\<in>| ta_der' \<A> (Fun f ts) \<longleftrightarrow> q |\<in>| ta_der \<A> (Fun f ts)"
   unfolding ta_der'.simps
   by (intro iffI funionI1 fCollect_memberI)
      (auto simp del: ta_der_Fun ta_der_Var simp: fset_image_conv)
 
 lemma ta_der'_Fun2:
   "Fun f ps |\<in>| ta_der' \<A> (Fun g ts) \<longleftrightarrow> f = g \<and> length ps = length ts \<and> (\<forall>i<length ts. ps ! i |\<in>| ta_der' \<A> (ts ! i))"
 proof -
   have f: "finite {ss. set ss \<subseteq> fset ( |\<Union>| (fset_of_list (map (ta_der' \<A>) ts))) \<and> length ss = length ts}"
     by (intro finite_lists_length_eq) auto
   have "finite {ss. length ss = length ts \<and> (\<forall>i<length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i))}"
     by (intro finite_subset[OF _ f])
        (force simp: in_fset_conv_nth simp flip: fset_of_list_elem)
   then show ?thesis unfolding ta_der'.simps
     by (intro iffI funionI2 fCollect_memberI)
        (auto simp del: ta_der_Fun ta_der_Var)
 qed
 
 declare ta_der'.simps[simp del]
 declare ta_der'.simps[code del]
 lemmas ta_der'_simps [simp] = ta_der'_Var ta_der'_Fun ta_der'_Fun2
 
 text \<open>Induction schemes for the most used cases\<close>
 
 lemma ta_der_induct[consumes 1, case_names Var Fun]:
   assumes reach: "q |\<in>| ta_der \<A> t"
   and VarI: "\<And> q v. v = q \<or> (v, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> P (Var v) q"
   and FunI: "\<And>f ts ps p q. f ps \<rightarrow> p |\<in>| rules \<A> \<Longrightarrow> length ts = length ps \<Longrightarrow> p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow>
     (\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (ts ! i)) \<Longrightarrow>
     (\<And>i. i < length ts \<Longrightarrow> P (ts ! i) (ps ! i)) \<Longrightarrow> P (Fun f ts) q"
   shows "P t q" using assms(1)
   by (induct t arbitrary: q) (auto simp: VarI FunI)
 
 lemma ta_der_gterm_induct[consumes 1, case_names GFun]:
   assumes reach: "q |\<in>| ta_der \<A> (term_of_gterm t)"
   and Fun: "\<And>f ts ps p q. TA_rule f ps p |\<in>| rules \<A> \<Longrightarrow> length ts = length ps \<Longrightarrow> p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow>
     (\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (term_of_gterm (ts ! i))) \<Longrightarrow>
     (\<And>i. i < length ts \<Longrightarrow> P (ts ! i) (ps ! i)) \<Longrightarrow> P (GFun f ts) q"
   shows "P t q" using assms(1)
   by (induct t arbitrary: q) (auto simp: Fun)
 
 lemma ta_der_rule_empty:
   assumes "q |\<in>| ta_der (TA {||} \<Delta>\<^sub>\<epsilon>) t"
   obtains p where "t = Var p" "p = q \<or> (p, q) |\<in>| \<Delta>\<^sub>\<epsilon>|\<^sup>+|"
   using assms by (cases t) auto
 
 lemma ta_der_eps:
   assumes "(p, q) |\<in>| (eps \<A>)" and "p |\<in>| ta_der \<A> t"
   shows "q |\<in>| ta_der \<A> t" using assms
   by (cases t) (auto intro: ftrancl_into_trancl)
 
 lemma ta_der_trancl_eps:
   assumes "(p, q) |\<in>| (eps \<A>)|\<^sup>+|" and "p |\<in>| ta_der \<A> t"
   shows "q |\<in>| ta_der \<A> t" using assms
   by (induct rule: ftrancl_induct) (auto intro: ftrancl_into_trancl ta_der_eps)
 
 lemma ta_der_mono:
   "(rules \<A>) |\<subseteq>| (rules \<B>) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \<B>) \<Longrightarrow> ta_der \<A> t |\<subseteq>| ta_der \<B> t"
 proof (induct t)
   case (Var x) then show ?case
     by (auto dest: ftrancl_mono[of _ "eps \<A>" "eps \<B>"])
 next
   case (Fun f ts)
   show ?case using Fun(1)[OF nth_mem Fun(2, 3)]
     by (auto dest!: fsubsetD[OF Fun(2)] ftrancl_mono[OF _ Fun(3)]) blast+
 qed
 
 lemma ta_der_el_mono:
   "(rules \<A>) |\<subseteq>| (rules \<B>) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \<B>) \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| ta_der \<B> t"
   using ta_der_mono by blast
 
 lemma ta_der'_ta_der:
   assumes "t |\<in>| ta_der' \<A> s" "p |\<in>| ta_der \<A> t"
   shows "p |\<in>| ta_der \<A> s" using assms
 proof (induction arbitrary: p t rule: ta_der'.induct)
   case (2 \<A> f ts) show ?case using 2(2-)
   proof (induction t)
     case (Var x) then show ?case
       by auto (meson ftrancl_trans)
   next
     case (Fun g ss)
     have ss_props: "g = f" "length ss = length ts" "\<forall>i < length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i)"
       using Fun(2) by auto
     then show ?thesis using Fun(1)[OF nth_mem] Fun(2-)
       by (auto simp: ss_props)
          (metis (no_types, lifting) "2.IH" ss_props(3))+  
   qed
 qed (auto dest: ftrancl_trans simp: ta_der'.simps)
 
 lemma ta_der'_empty:
   assumes "t |\<in>| ta_der' (TA {||} {||}) s"
   shows "t = s" using assms
   by (induct s arbitrary: t) (auto simp add: ta_der'.simps nth_equalityI)
 
 lemma ta_der'_to_ta_der:
   "Var q |\<in>| ta_der' \<A> s \<Longrightarrow> q |\<in>| ta_der \<A> s"
   using ta_der'_ta_der by fastforce
 
 lemma ta_der_to_ta_der':
   "q |\<in>| ta_der \<A> s \<longleftrightarrow> Var q |\<in>| ta_der' \<A> s "
   by (induct s arbitrary: q) auto
 
 lemma ta_der'_poss:
   assumes "t |\<in>| ta_der' \<A> s"
   shows "poss t \<subseteq> poss s" using assms
 proof (induct s arbitrary: t)
   case (Fun f ts)
   show ?case using Fun(2) Fun(1)[OF nth_mem, of i "args t ! i" for i]
     by (cases t) auto
 qed (auto simp: ta_der'.simps)
 
 lemma ta_der'_refl[simp]: "t |\<in>| ta_der' \<A> t"
   by (induction t) fastforce+
 
 lemma ta_der'_eps:
   assumes "Var p |\<in>| ta_der' \<A> s" and "(p, q) |\<in>| (eps \<A>)|\<^sup>+|"
   shows "Var q |\<in>| ta_der' \<A> s" using assms
   by (cases s, auto dest: ftrancl_trans) (meson ftrancl_trans)
 
 lemma ta_der'_trans:
   assumes "t |\<in>| ta_der' \<A> s" and "u |\<in>| ta_der' \<A> t"
   shows "u |\<in>| ta_der' \<A> s" using assms
 proof (induct t arbitrary: u s)
   case (Fun f ts) note IS = Fun(2-) note IH = Fun(1)[OF nth_mem, of i "args s ! i" for i]
   show ?case
   proof (cases s)
     case (Var x1)
     then show ?thesis using IS by (auto simp: ta_der'.simps)
   next
     case [simp]: (Fun g ss)
     show ?thesis using IS IH
       by (cases u, auto) (metis ta_der_to_ta_der')+
   qed
 qed (auto simp: ta_der'.simps ta_der'_eps)
 
 text \<open>Connecting contexts to derivation definition\<close>
 
 lemma ta_der_ctxt:
   assumes p: "p |\<in>| ta_der \<A> t" "q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>"
   shows "q |\<in>| ta_der \<A> C\<langle>t\<rangle>" using assms(2)
 proof (induct C arbitrary: q)
   case Hole then show ?case using assms
     by (auto simp: ta_der_trancl_eps)
 next
   case (More f ss C ts)
   from More(2) obtain qs r where
     rule: "f qs \<rightarrow> r |\<in>| rules \<A>" "length qs = Suc (length ss + length ts)" and
     reach: "\<forall> i < Suc (length ss + length ts). qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>Var p\<rangle> # ts) ! i)" "r = q \<or> (r, q) |\<in>| (eps \<A>)|\<^sup>+|"
     by auto
   have "i < Suc (length ss + length ts) \<Longrightarrow> qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>t\<rangle> # ts) ! i)" for i
     using More(1)[of "qs ! length ss"] assms rule(2) reach(1)
     unfolding nth_append_Cons by presburger
   then show ?case using rule reach(2) by auto
 qed
 
 lemma ta_der_eps_ctxt:
   assumes "p |\<in>| ta_der A C\<langle>Var q'\<rangle>" and "(q, q') |\<in>| (eps A)|\<^sup>+|"
   shows "p |\<in>| ta_der A C\<langle>Var q\<rangle>"
   using assms by (meson ta_der_Var ta_der_ctxt) 
 
 lemma rule_reachable_ctxt_exist:
   assumes rule: "f qs \<rightarrow> q |\<in>| rules \<A>" and "i < length qs"
   shows "\<exists> C. q |\<in>| ta_der \<A> (C \<langle>Var (qs ! i)\<rangle>)" using assms
   by (intro exI[of _ "More f (map Var (take i qs)) \<box> (map Var (drop (Suc i) qs))"])
      (auto simp: min_def nth_append_Cons intro!: exI[of _ q] exI[of _ qs])
 
 lemma ta_der_ctxt_decompose:
   assumes "q |\<in>| ta_der \<A> C\<langle>t\<rangle>"
   shows "\<exists> p . p |\<in>| ta_der \<A> t \<and> q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" using assms
 proof (induct C arbitrary: q)
   case (More f ss C ts)
   from More(2) obtain qs r where
     rule: "f qs \<rightarrow> r |\<in>| rules \<A>" "length qs = Suc (length ss + length ts)" and
     reach: "\<forall> i < Suc (length ss + length ts). qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>t\<rangle> # ts) ! i)"
        "r = q \<or> (r, q) |\<in>| (eps \<A>)|\<^sup>+|"
     by auto
   obtain p where p: "p |\<in>| ta_der \<A> t" "qs ! length ss |\<in>| ta_der \<A> C\<langle>Var p\<rangle>"
     using More(1)[of "qs ! length ss"] reach(1) rule(2)
     by (metis less_add_Suc1 nth_append_length)
   have "i < Suc (length ss + length ts) \<Longrightarrow> qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>Var p\<rangle> # ts) ! i)" for i
     using reach rule(2) p by (auto simp: p(2) nth_append_Cons)
   then have "q |\<in>| ta_der \<A> (More f ss C ts)\<langle>Var p\<rangle>" using rule reach
     by auto
   then show ?case using p(1) by (intro exI[of _ p]) blast
 qed auto
 
 \<comment> \<open>Relation between reachable states and states of a tree automaton\<close>
 
 lemma ta_der_states:
   "ta_der \<A> t |\<subseteq>| \<Q> \<A> |\<union>| fvars_term t"
 proof (induct t)
   case (Var x) then show ?case
     by (auto simp: eq_onp_same_args) 
        (metis eps_trancl_statesD)
   case (Fun f ts) then show ?case
     by (auto simp: rule_statesD(2) eps_trancl_statesD)
 qed
 
 lemma ground_ta_der_states:
   "ground t \<Longrightarrow> ta_der \<A> t |\<subseteq>| \<Q> \<A>"
   using ta_der_states[of \<A> t] by auto
 
 lemmas ground_ta_der_statesD = fsubsetD[OF ground_ta_der_states]
 
 lemma gterm_ta_der_states [simp]:
   "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> q |\<in>| \<Q> \<A>"
   by (intro ground_ta_der_states[THEN fsubsetD, of "term_of_gterm t"]) simp
 
 lemma ta_der_states':
   "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| \<Q> \<A> \<Longrightarrow> fvars_term t |\<subseteq>| \<Q> \<A>"
 proof (induct rule: ta_der_induct)
   case (Fun f ts ps p r)
   then have "i < length ts \<Longrightarrow> fvars_term (ts ! i) |\<subseteq>| \<Q> \<A>" for i
     by (auto simp: in_fset_conv_nth dest!: rule_statesD(3))
   then show ?case by (force simp: in_fset_conv_nth)
 qed (auto simp: eps_trancl_statesD)
 
 lemma ta_der_not_stateD:
   "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<notin>| \<Q> \<A> \<Longrightarrow> t = Var q"
   using fsubsetD[OF ta_der_states, of q \<A> t]
   by (cases t) (auto dest: rule_statesD eps_trancl_statesD)
 
 lemma ta_der_is_fun_stateD:
   "is_Fun t \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| \<Q> \<A>"
   using ta_der_not_stateD[of q \<A> t]
   by (cases t) auto
 
 lemma ta_der_is_fun_fvars_stateD:
   "is_Fun t \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> fvars_term t |\<subseteq>| \<Q> \<A>"
   using ta_der_is_fun_stateD[of t q \<A>]
   using ta_der_states'[of q \<A> t]
   by (cases t) auto
 
 lemma ta_der_not_reach:
   assumes "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> r_rhs r \<noteq> q"
     and "\<And> e. e |\<in>| eps \<A> \<Longrightarrow> snd e \<noteq> q"
   shows "q |\<notin>| ta_der \<A> (term_of_gterm t)" using assms
   by (cases t) (fastforce dest!: assms(1) ftranclD2[of _ q])
 
 
 lemma ta_rhs_states_subset_states: "ta_rhs_states \<A> |\<subseteq>| \<Q> \<A>"
   by (auto simp: ta_rhs_states_def dest: rtranclD rule_statesD eps_trancl_statesD)
 
 (* a resulting state is always some rhs of a rule (or epsilon transition) *)
 lemma ta_rhs_states_res: assumes "is_Fun t" 
   shows "ta_der \<A> t |\<subseteq>| ta_rhs_states \<A>"
 proof
   fix q assume q: "q |\<in>| ta_der \<A> t"
   from \<open>is_Fun t\<close> obtain f ts where t: "t = Fun f ts" by (cases t, auto)
   from q[unfolded t] obtain q' qs where "TA_rule f qs q' |\<in>| rules \<A>" 
     and q: "q' = q \<or> (q', q) |\<in>| (eps \<A>)|\<^sup>+|" by auto
   then show "q |\<in>| ta_rhs_states \<A>" unfolding ta_rhs_states_def
     by (auto intro!: bexI)
 qed
 
 text \<open>Reachable states of ground terms are preserved over the @{const adapt_vars} function\<close>
 
 lemma ta_der_adapt_vars_ground [simp]:
   "ground t \<Longrightarrow> ta_der A (adapt_vars t) = ta_der A t"
   by (induct t) auto
 
 lemma gterm_of_term_inv':
   "ground t \<Longrightarrow> term_of_gterm (gterm_of_term t) = adapt_vars t"
   by (induct t) (auto 0 0 intro!: nth_equalityI)
 
 lemma map_vars_term_term_of_gterm:
   "map_vars_term f (term_of_gterm t) = term_of_gterm t"
   by (induct t) auto
 
 lemma adapt_vars_term_of_gterm:
   "adapt_vars (term_of_gterm t) = term_of_gterm t"
   by (induct t) auto
 
 (* a term can be reduced to a state, only if all symbols appear in the automaton *)
 lemma ta_der_term_sig:
   "q |\<in>| ta_der \<A> t \<Longrightarrow> ffunas_term t |\<subseteq>| ta_sig \<A>"
 proof (induct rule: ta_der_induct)
   case (Fun f ts ps p q)
   show ?case using Fun(1 - 4) Fun(5)[THEN fsubsetD]
     by (auto simp: in_fset_conv_nth)
 qed auto
 
 lemma ta_der_gterm_sig:
   "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> ffunas_gterm t |\<subseteq>| ta_sig \<A>"
   using ta_der_term_sig ffunas_term_of_gterm_conv
   by fastforce
 
 text \<open>@{const ta_lang} for terms with arbitrary variable type\<close>
 
 lemma ta_langE: assumes "t \<in> ta_lang Q \<A>"
   obtains t' q where "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'"
   using assms unfolding ta_lang_def by blast
 
 lemma ta_langI: assumes "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'"
   shows "t \<in> ta_lang Q \<A>"
   using assms unfolding ta_lang_def by blast
 
 lemma ta_lang_def2: "(ta_lang Q (\<A> :: ('q,'f)ta) :: ('f,'v)terms) = {t. ground t \<and> Q |\<inter>| ta_der \<A> (adapt_vars t) \<noteq> {||}}"
   by (auto elim!: ta_langE) (metis adapt_vars_adapt_vars ground_adapt_vars ta_langI)
 
 text \<open>@{const ta_lang} for @{const gterms}\<close>
 
 lemma ta_lang_to_gta_lang [simp]:
   "ta_lang Q \<A> = term_of_gterm ` gta_lang Q \<A>" (is "?Ls = ?Rs")
 proof -
   {fix t assume "t \<in> ?Ls"
     from ta_langE[OF this] obtain q t' where "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'"
       by blast
     then have "t \<in> ?Rs" unfolding gta_lang_def gta_der_def
       by (auto simp: image_iff gterm_of_term_inv' intro!: exI[of _ "gterm_of_term t'"])}
   moreover
   {fix t assume "t \<in> ?Rs" then have "t \<in> ?Ls"
       using ta_langI[OF ground_term_of_gterm _ _  gterm_of_term_inv'[OF ground_term_of_gterm]]
       by (force simp: gta_lang_def gta_der_def)}
   ultimately show ?thesis by blast
 qed
 
 lemma term_of_gterm_in_ta_lang_conv:
   "term_of_gterm t \<in> ta_lang Q \<A> \<longleftrightarrow> t \<in> gta_lang Q \<A>"
   by (metis (mono_tags, lifting) image_iff ta_lang_to_gta_lang term_of_gterm_inv)
 
 lemma gta_lang_def_sym:
   "gterm_of_term ` ta_lang Q \<A> = gta_lang Q \<A>"
   (* this is nontrivial because the lhs has a more general type than the rhs of gta_lang_def *)
   unfolding gta_lang_def image_def
   by (intro Collect_cong) (simp add: gta_lang_def)
 
 lemma gta_langI [intro]:
   assumes "q |\<in>| Q" and "q |\<in>| ta_der \<A> (term_of_gterm t)"
   shows "t \<in> gta_lang Q \<A>" using assms
   by (metis adapt_vars_term_of_gterm ground_term_of_gterm ta_langI term_of_gterm_in_ta_lang_conv)
 
 lemma gta_langE [elim]:
   assumes "t \<in> gta_lang Q \<A>"
   obtains q where "q |\<in>| Q" and "q |\<in>| ta_der \<A> (term_of_gterm t)" using assms
   by (metis adapt_vars_adapt_vars adapt_vars_term_of_gterm ta_langE term_of_gterm_in_ta_lang_conv) 
 
 lemma gta_lang_mono:
   assumes "\<And> t. ta_der \<A> t |\<subseteq>| ta_der \<BB> t" and "Q\<^sub>\<A> |\<subseteq>| Q\<^sub>\<BB>"
   shows "gta_lang Q\<^sub>\<A> \<A> \<subseteq> gta_lang Q\<^sub>\<BB> \<BB>"
   using assms by (auto elim!: gta_langE intro!: gta_langI)
 
 lemma gta_lang_term_of_gterm [simp]:
   "term_of_gterm t \<in> term_of_gterm ` gta_lang Q \<A> \<longleftrightarrow> t \<in> gta_lang Q \<A>"
   by (auto elim!: gta_langE intro!: gta_langI) (metis term_of_gterm_inv)
 
 (* terms can be accepted, only if all their symbols appear in the automaton *)
 lemma gta_lang_subset_rules_funas:
   "gta_lang Q \<A> \<subseteq> \<T>\<^sub>G (fset (ta_sig \<A>))"
   using ta_der_gterm_sig[THEN fsubsetD]
   by (force simp: \<T>\<^sub>G_equivalent_def ffunas_gterm.rep_eq)
 
 lemma reg_funas:
   "\<L> \<A> \<subseteq> \<T>\<^sub>G (fset (ta_sig (ta \<A>)))" using gta_lang_subset_rules_funas
   by (auto simp: \<L>_def)
 
 lemma ta_syms_lang: "t \<in> ta_lang Q \<A> \<Longrightarrow> ffunas_term t |\<subseteq>| ta_sig \<A>"
   using gta_lang_subset_rules_funas ffunas_gterm_gterm_of_term ta_der_gterm_sig ta_lang_def2
   by fastforce
 
 lemma gta_lang_Rest_states_conv:
   "gta_lang Q \<A> = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>"
   by (auto elim!: gta_langE)
 
 lemma reg_Rest_fin_states [simp]:
   "\<L> (reg_Restr_Q\<^sub>f \<A>) = \<L> \<A>"
   using gta_lang_Rest_states_conv
   by (auto simp: \<L>_def reg_Restr_Q\<^sub>f_def)
 
 text \<open>Deterministic tree automatons\<close>
 
 definition ta_det :: "('q,'f) ta \<Rightarrow> bool" where
   "ta_det \<A> \<longleftrightarrow> eps \<A> = {||} \<and> 
     (\<forall> f qs q q'. TA_rule f qs q |\<in>| rules \<A> \<longrightarrow> TA_rule f qs q' |\<in>| rules \<A> \<longrightarrow> q = q')"
 
 definition "ta_subset \<A> \<B> \<longleftrightarrow> rules \<A> |\<subseteq>| rules \<B> \<and> eps \<A> |\<subseteq>| eps \<B>"
 
 (* determinism implies unique results *)
 lemma ta_detE[elim, consumes 1]: assumes det: "ta_det \<A>"
   shows "q |\<in>| ta_der \<A> t \<Longrightarrow> q' |\<in>| ta_der \<A> t \<Longrightarrow> q = q'" using assms
   by (induct t arbitrary: q q') (auto simp: ta_det_def, metis nth_equalityI nth_mem)
 
 
 lemma ta_subset_states: "ta_subset \<A> \<B> \<Longrightarrow> \<Q> \<A> |\<subseteq>| \<Q> \<B>"
   using \<Q>_mono by (auto simp: ta_subset_def)
 
 lemma ta_subset_refl[simp]: "ta_subset \<A> \<A>" 
   unfolding ta_subset_def by auto
 
 lemma ta_subset_trans: "ta_subset \<A> \<B> \<Longrightarrow> ta_subset \<B> \<CC> \<Longrightarrow> ta_subset \<A> \<CC>"
   unfolding ta_subset_def by auto
 
 lemma ta_subset_det: "ta_subset \<A> \<B> \<Longrightarrow> ta_det \<B> \<Longrightarrow> ta_det \<A>"
   unfolding ta_det_def ta_subset_def by blast
 
 lemma ta_der_mono': "ta_subset \<A> \<B> \<Longrightarrow> ta_der \<A> t |\<subseteq>| ta_der \<B> t"
   using ta_der_mono unfolding ta_subset_def by auto
 
 lemma ta_lang_mono': "ta_subset \<A> \<B> \<Longrightarrow> Q\<^sub>\<A> |\<subseteq>| Q\<^sub>\<B> \<Longrightarrow> ta_lang Q\<^sub>\<A> \<A> \<subseteq> ta_lang Q\<^sub>\<B> \<B>"
   using gta_lang_mono[of \<A> \<B>] ta_der_mono'[of \<A> \<B>]
   by auto blast
 
 (* the restriction of an automaton to a given set of states *)
 lemma ta_restrict_subset: "ta_subset (ta_restrict \<A> Q) \<A>"
   unfolding ta_subset_def ta_restrict_def
   by auto
 
 lemma ta_restrict_states_Q: "\<Q> (ta_restrict \<A> Q) |\<subseteq>| Q"
   by (auto simp: \<Q>_def ta_restrict_def rule_states_def eps_states_def dest!: fsubsetD)
 
 lemma ta_restrict_states: "\<Q> (ta_restrict \<A> Q) |\<subseteq>| \<Q> \<A>"
   using ta_subset_states[OF ta_restrict_subset] by fastforce 
 
 lemma ta_restrict_states_eq_imp_eq [simp]:
   assumes eq: "\<Q> (ta_restrict \<A> Q) = \<Q> \<A>"
   shows "ta_restrict \<A> Q = \<A>" using assms
   apply (auto simp: ta_restrict_def
               intro!: ta.expand finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>])
   apply (metis (no_types, lifting) eq fsubsetD fsubsetI rule_statesD(1) rule_statesD(4) ta_restrict_states_Q ta_rule.collapse)
   apply (metis eps_statesD eq fin_mono ta_restrict_states_Q)
   by (metis eps_statesD eq fsubsetD ta_restrict_states_Q)
 
 lemma ta_der_ta_derict_states:
   "fvars_term t |\<subseteq>| Q \<Longrightarrow> q |\<in>| ta_der (ta_restrict \<A> Q) t \<Longrightarrow> q |\<in>| Q"
   by (induct t arbitrary: q) (auto simp: ta_restrict_def elim: ftranclE)
 
 lemma ta_derict_ruleI [intro]:
   "TA_rule f qs q |\<in>| rules \<A> \<Longrightarrow> fset_of_list qs |\<subseteq>| Q \<Longrightarrow> q |\<in>| Q \<Longrightarrow> TA_rule f qs q |\<in>| rules (ta_restrict \<A> Q)"
   by (auto simp: ta_restrict_def intro!: ta.expand finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>])
 
 text \<open>Reachable and productive states: There always is a trim automaton\<close>
 
 lemma finite_ta_reachable [simp]:
   "finite {q. \<exists>t. ground t \<and> q |\<in>| ta_der \<A> t}"
 proof -
   have "{q. \<exists>t. ground t \<and> q |\<in>| ta_der \<A> t} \<subseteq> fset (\<Q> \<A>)"
     using ground_ta_der_states[of _ \<A>]
     by auto
   from finite_subset[OF this] show ?thesis by auto
 qed
 
 lemma ta_reachable_states:
   "ta_reachable \<A> |\<subseteq>| \<Q> \<A>"
   unfolding ta_reachable_def using ground_ta_der_states
   by force
 
 lemma ta_reachableE:
   assumes "q |\<in>| ta_reachable \<A>"
   obtains t where "ground t" "q |\<in>| ta_der \<A> t"
   using assms[unfolded ta_reachable_def] by auto
 
 lemma ta_reachable_gtermE [elim]:
   assumes "q |\<in>| ta_reachable \<A>"
   obtains t where "q |\<in>| ta_der \<A> (term_of_gterm t)"
   using ta_reachableE[OF assms]
   by (metis ground_term_to_gtermD) 
 
 lemma ta_reachableI [intro]:
   assumes "ground t" and "q |\<in>| ta_der \<A> t"
   shows "q |\<in>| ta_reachable \<A>"
   using assms finite_ta_reachable
   by (auto simp: ta_reachable_def)
 
 lemma ta_reachable_gtermI [intro]:
   "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> q |\<in>| ta_reachable \<A>"
   by (intro ta_reachableI[of "term_of_gterm t"]) simp
 
 lemma ta_reachableI_rule:
   assumes sub: "fset_of_list qs |\<subseteq>| ta_reachable \<A>"
     and rule: "TA_rule f qs q |\<in>| rules \<A>"
   shows "q |\<in>| ta_reachable \<A>"
     "\<exists> ts. length qs = length ts \<and> (\<forall> i < length ts. ground (ts ! i)) \<and>
       (\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i))" (is "?G")
 proof -
   {
     fix i
     assume i: "i < length qs"
     then have "qs ! i |\<in>| fset_of_list qs" by auto
     with sub have "qs ! i |\<in>| ta_reachable \<A>" by auto
     from ta_reachableE[OF this] have "\<exists> t. ground t \<and> qs ! i |\<in>| ta_der \<A> t" by auto
   }
   then have "\<forall> i. \<exists> t. i < length qs \<longrightarrow> ground t \<and> qs ! i |\<in>| ta_der \<A> t" by auto
   from choice[OF this] obtain ts where ts: "\<And> i. i < length qs \<Longrightarrow> ground (ts i) \<and> qs ! i |\<in>| ta_der \<A> (ts i)" by blast
   let ?t = "Fun f (map ts [0 ..< length qs])"
   have gt: "ground ?t" using ts by auto
   have r: "q |\<in>| ta_der \<A> ?t" unfolding ta_der_Fun using rule ts
     by (intro exI[of _ qs] exI[of _ q]) simp
   with gt show "q |\<in>| ta_reachable \<A>" by blast
   from gt ts show ?G by (intro exI[of _ "map ts [0..<length qs]"]) simp
 qed
 
 lemma ta_reachable_rule_gtermE:
   assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>"
     and "TA_rule f qs q |\<in>| rules \<A>"
   obtains t where "groot t = (f, length qs)" "q |\<in>| ta_der \<A> (term_of_gterm t)"
 proof -
   assume *: "\<And>t. groot t = (f, length qs) \<Longrightarrow> q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> thesis"
   from assms have "fset_of_list qs |\<subseteq>| ta_reachable \<A>"
     by (auto dest: rule_statesD(3))
   from ta_reachableI_rule[OF this assms(2)] obtain ts where args: "length qs = length ts"
     "\<forall> i < length ts. ground (ts ! i)" "\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i)"
     using assms by force
   then show ?thesis using assms(2)
     by (intro *[of "GFun f (map gterm_of_term ts)"]) auto
 qed
 
 lemma ta_reachableI_eps':
   assumes reach: "q |\<in>| ta_reachable \<A>"
     and eps: "(q, q') |\<in>| (eps \<A>)|\<^sup>+|"  
   shows "q' |\<in>| ta_reachable \<A>"
 proof -
   from ta_reachableE[OF reach] obtain t where g: "ground t" and res: "q |\<in>| ta_der \<A> t" by auto
   from ta_der_trancl_eps[OF eps res] g show ?thesis by blast
 qed
 
 lemma ta_reachableI_eps:
   assumes reach: "q |\<in>| ta_reachable \<A>"
     and eps: "(q, q') |\<in>| eps \<A>"  
   shows "q' |\<in>| ta_reachable \<A>"
   by (rule ta_reachableI_eps'[OF reach], insert eps, auto)
 
 \<comment> \<open>Automata are productive on a set P if all states can reach a state in P\<close>
 
 
 lemma finite_ta_productive:
   "finite {p. \<exists>q q' C. p = q \<and> q' |\<in>| ta_der \<A> C\<langle>Var q\<rangle> \<and> q' |\<in>| P}"
 proof -
   {fix x q C assume ass: "x \<notin> fset P" "q |\<in>| P" "q |\<in>| ta_der \<A> C\<langle>Var x\<rangle>"
     then have "x \<in> fset (\<Q> \<A>)"
     proof (cases "is_Fun C\<langle>Var x\<rangle>")
       case True
       then show ?thesis using ta_der_is_fun_fvars_stateD[OF _ ass(3)]
         by auto
     next
       case False
       then show ?thesis using ass
         by (cases C, auto, (metis eps_trancl_statesD)+)
     qed}
   then have "{q | q q' C. q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| P} \<subseteq> fset (\<Q> \<A>) \<union> fset P" by auto
   from finite_subset[OF this] show ?thesis by auto
 qed
 
 lemma ta_productiveE: assumes "q |\<in>| ta_productive P \<A>"
   obtains q' C where "q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>)" "q' |\<in>| P" 
   using assms[unfolded ta_productive_def] by auto
 
 lemma ta_productiveI:
   assumes "q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>)" "q' |\<in>| P" 
   shows "q |\<in>| ta_productive P \<A>"
   using assms unfolding ta_productive_def
   using finite_ta_productive
   by auto
 
 lemma ta_productiveI': 
   assumes "q |\<in>| ta_der \<A> (C\<langle>Var p\<rangle>)" "q |\<in>| ta_productive P \<A>" 
   shows "p |\<in>| ta_productive P \<A>"
   using assms unfolding ta_productive_def
   by auto (metis (mono_tags, lifting) ctxt_ctxt_compose ta_der_ctxt)
 
 lemma ta_productive_setI:
   "q |\<in>| P \<Longrightarrow> q |\<in>| ta_productive P \<A>"
   using ta_productiveI[of q \<A> \<box> q]
   by simp
 
 
 lemma ta_reachable_empty_rules [simp]:
   "rules \<A> = {||} \<Longrightarrow> ta_reachable \<A> = {||}"
   by (auto simp: ta_reachable_def)
      (metis ground.simps(1) ta.exhaust_sel ta_der_rule_empty)
 
 lemma ta_reachable_mono:
   "ta_subset \<A> \<B> \<Longrightarrow> ta_reachable \<A> |\<subseteq>| ta_reachable \<B>" using ta_der_mono'
   by (auto simp: ta_reachable_def) blast
 
 lemma ta_reachabe_rhs_states: 
   "ta_reachable \<A> |\<subseteq>| ta_rhs_states \<A>"
 proof -
   {fix q assume "q |\<in>| ta_reachable \<A>"
     then obtain t where "ground t" "q |\<in>| ta_der \<A> t"
       by (auto simp: ta_reachable_def)
     then have "q |\<in>| ta_rhs_states \<A>"
       by (cases t) (auto simp: ta_rhs_states_def intro!: bexI)}
   then show ?thesis by blast
 qed
 
 lemma ta_reachable_eps:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> p |\<in>| ta_reachable \<A> \<Longrightarrow> (p, q) |\<in>| (fRestr (eps \<A>) (ta_reachable \<A>))|\<^sup>+|"
 proof (induct rule: ftrancl_induct)
   case (Base a b)
   then show ?case
     by (metis fSigmaI finterI fr_into_trancl ta_reachableI_eps)
 next
   case (Step p q r)
   then have "q |\<in>| ta_reachable \<A>" "r |\<in>| ta_reachable \<A>"
     by (metis ta_reachableI_eps ta_reachableI_eps')+
   then show ?case using Step
     by (metis fSigmaI finterI ftrancl_into_trancl)
 qed
 
 (* major lemma to show that one can restrict to reachable states *)
 lemma ta_der_only_reach:
   assumes "fvars_term t |\<subseteq>| ta_reachable \<A>"
   shows "ta_der \<A> t = ta_der (ta_only_reach \<A>) t" (is "?LS = ?RS")
 proof -
   have "?RS |\<subseteq>| ?LS" using ta_der_mono'[OF ta_restrict_subset]
     by fastforce
   moreover
   {fix q assume "q |\<in>| ?LS"
     then have "q |\<in>| ?RS" using assms
     proof (induct rule: ta_der_induct)
       case (Fun f ts ps p q)
       from Fun(2, 6) have ta_reach [simp]: "i < length ps \<Longrightarrow> fvars_term (ts ! i) |\<subseteq>| ta_reachable \<A>" for i
         by auto (metis ffUnionI fimage_fset fnth_mem funionI2 length_map nth_map sup.orderE) 
       from Fun have r: "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der (ta_only_reach \<A>) (ts ! i)"
         "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_reachable \<A>" for i
         by (auto) (metis ta_reach ta_der_ta_derict_states)+
       then have "f ps \<rightarrow> p |\<in>| rules (ta_only_reach \<A>)"
         using Fun(1, 2)
         by (intro ta_derict_ruleI)
            (fastforce simp: in_fset_conv_nth intro!: ta_reachableI_rule[OF _ Fun(1)])+
       then show ?case using ta_reachable_eps[of p q] ta_reachableI_rule[OF _ Fun(1)] r Fun(2, 3)
         by (auto simp: ta_restrict_def intro!: exI[of _ p] exI[of _ ps])
     qed (auto simp: ta_restrict_def intro: ta_reachable_eps)}
   ultimately show ?thesis by blast
 qed
 
 lemma ta_der_gterm_only_reach:
   "ta_der \<A> (term_of_gterm t) = ta_der (ta_only_reach \<A>) (term_of_gterm t)"
   using ta_der_only_reach[of "term_of_gterm t" \<A>]
   by simp
 
 lemma ta_reachable_ta_only_reach [simp]:
   "ta_reachable (ta_only_reach \<A>) = ta_reachable \<A>"  (is "?LS = ?RS")
 proof -
   have "?LS |\<subseteq>| ?RS" using ta_der_mono'[OF ta_restrict_subset]
     by (auto simp: ta_reachable_def) fastforce
   moreover
   {fix t assume "ground (t :: ('b, 'a) term)"
     then have "ta_der \<A> t = ta_der (ta_only_reach \<A>) t" using ta_der_only_reach[of t \<A>]
       by simp}
   ultimately show ?thesis unfolding ta_reachable_def
     by auto
 qed
 
 lemma ta_only_reach_reachable:
   "\<Q> (ta_only_reach \<A>) |\<subseteq>| ta_reachable (ta_only_reach \<A>)"
   using ta_restrict_states_Q[of \<A> "ta_reachable \<A>"]
   by auto
 
 (* It is sound to restrict to reachable states. *)
 lemma gta_only_reach_lang:
   "gta_lang Q (ta_only_reach \<A>) = gta_lang Q \<A>"
   using ta_der_gterm_only_reach
   by (auto elim!: gta_langE intro!: gta_langI) force+
 
 
 lemma \<L>_only_reach: "\<L> (reg_reach R) = \<L> R"
   using gta_only_reach_lang
   by (auto simp: \<L>_def reg_reach_def)
 
 lemma ta_only_reach_lang:
   "ta_lang Q (ta_only_reach \<A>) = ta_lang Q \<A>"
   using gta_only_reach_lang
   by (metis ta_lang_to_gta_lang)
 
 
 lemma ta_prod_epsD:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> p |\<in>| ta_productive P \<A>"
   using ta_der_ctxt[of q \<A> "\<box>\<langle>Var p\<rangle>"]
   by (auto simp: ta_productive_def ta_der_trancl_eps)
 
 lemma ta_only_prod_eps:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> (p, q) |\<in>| (eps (ta_only_prod P \<A>))|\<^sup>+|"
 proof (induct rule: ftrancl_induct)
   case (Base p q)
   then show ?case
     by (metis (no_types, lifting) fSigmaI finterI fr_into_trancl ta.sel(2) ta_prod_epsD ta_restrict_def)
 next
   case (Step p q r) note IS = this
   show ?case using IS(2 - 4) ta_prod_epsD[OF fr_into_trancl[OF IS(3)] IS(4)] 
     by (auto simp: ta_restrict_def) (simp add: ftrancl_into_trancl)
 qed
 
 (* Major lemma to show that it is sound to restrict to productive states. *)
 lemma ta_der_only_prod: 
   "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> q |\<in>| ta_der (ta_only_prod P \<A>) t"
 proof (induct rule: ta_der_induct)
   case (Fun f ts ps p q)
   let ?\<A> = "ta_only_prod P \<A>"
   have pr: "p |\<in>| ta_productive P \<A>" "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_productive P \<A>" for i
     using Fun(2) ta_prod_epsD[of p q] Fun(3, 6) rule_reachable_ctxt_exist[OF Fun(1)]
     using ta_productiveI'[of p \<A> _ "ps ! i" P]
     by auto
   then have "f ps \<rightarrow> p |\<in>| rules ?\<A>" using Fun(1, 2) unfolding ta_restrict_def
     by (auto simp: in_fset_conv_nth intro: finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>])
   then show ?case using pr Fun ta_only_prod_eps[of p q \<A> P] Fun(3, 6)
     by auto
 qed (auto intro: ta_only_prod_eps)
 
 lemma ta_der_ta_only_prod_ta_der:
   "q |\<in>| ta_der (ta_only_prod P \<A>) t \<Longrightarrow> q |\<in>| ta_der \<A> t"
   by (meson ta_der_el_mono ta_restrict_subset ta_subset_def)
 
 
 (* It is sound to restrict to productive states. *)
 lemma gta_only_prod_lang:
   "gta_lang Q (ta_only_prod Q \<A>) = gta_lang Q \<A>" (is "gta_lang Q ?\<A> = _")
 proof
   show "gta_lang Q ?\<A> \<subseteq> gta_lang Q \<A>"
     using gta_lang_mono[OF ta_der_mono'[OF ta_restrict_subset]]
     by blast
 next
   {fix t assume "t \<in> gta_lang Q \<A>"
     from gta_langE[OF this] obtain q where
       reach: "q |\<in>| ta_der \<A> (term_of_gterm t)" "q |\<in>| Q" .
     from ta_der_only_prod[OF reach(1) ta_productive_setI[OF reach(2)]] reach(2)
     have "t \<in> gta_lang Q ?\<A>" by (auto intro: gta_langI)}
   then show "gta_lang Q \<A> \<subseteq> gta_lang Q ?\<A>" by blast
 qed
 
 lemma \<L>_only_prod: "\<L> (reg_prod R) = \<L> R"
   using gta_only_prod_lang
   by (auto simp: \<L>_def reg_prod_def)
 
 lemma ta_only_prod_lang:
   "ta_lang Q (ta_only_prod Q \<A>) = ta_lang Q \<A>"
   using gta_only_prod_lang
   by (metis ta_lang_to_gta_lang)
 
 (* the productive states are also productive w.r.t. the new automaton *)
 lemma ta_prodictive_ta_only_prod [simp]:
   "ta_productive P (ta_only_prod P \<A>) = ta_productive P \<A>"  (is "?LS = ?RS")
 proof -
   have "?LS |\<subseteq>| ?RS" using ta_der_mono'[OF ta_restrict_subset]
     using finite_ta_productive[of \<A> P]
     by (auto simp: ta_productive_def) fastforce
   moreover have "?RS |\<subseteq>| ?LS" using ta_der_only_prod
     by (auto elim!: ta_productiveE)
        (smt (z3) ta_der_only_prod ta_productiveI ta_productive_setI)
   ultimately show ?thesis by blast
 qed
 
 lemma ta_only_prod_productive:
   "\<Q> (ta_only_prod P \<A>) |\<subseteq>| ta_productive P (ta_only_prod P \<A>)"
   using ta_restrict_states_Q by force
 
 lemma ta_only_prod_reachable:
   assumes all_reach: "\<Q> \<A> |\<subseteq>| ta_reachable \<A>"
   shows "\<Q> (ta_only_prod P \<A>) |\<subseteq>| ta_reachable (ta_only_prod P \<A>)" (is "?Ls |\<subseteq>| ?Rs")
 proof -
   {fix q assume "q |\<in>| ?Ls"
     then obtain t where "ground t" "q |\<in>| ta_der \<A> t" "q |\<in>| ta_productive P \<A>"
       using fsubsetD[OF ta_only_prod_productive[of \<A> P]]
       using fsubsetD[OF fsubset_trans[OF ta_restrict_states all_reach, of "ta_productive P \<A>"]]
       by (auto elim!: ta_reachableE)
     then have "q |\<in>| ?Rs"
       by (intro ta_reachableI[where ?\<A> = "ta_only_prod P \<A>" and ?t = t]) (auto simp: ta_der_only_prod)}
   then show ?thesis by blast
 qed
 
 lemma ta_prod_reach_subset:
   "ta_subset (ta_only_prod P (ta_only_reach \<A>)) \<A>"
   by (rule ta_subset_trans, (rule ta_restrict_subset)+)
 
 lemma ta_prod_reach_states:
   "\<Q> (ta_only_prod P (ta_only_reach \<A>)) |\<subseteq>| \<Q> \<A>"
   by (rule ta_subset_states[OF ta_prod_reach_subset])
 
 (* If all states are reachable then there exists a ground context for all productive states *)
 lemma ta_productive_aux:
   assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" "q |\<in>| ta_der \<A> (C\<langle>t\<rangle>)"
   shows "\<exists>C'. ground_ctxt C' \<and> q |\<in>| ta_der \<A> (C'\<langle>t\<rangle>)" using assms(2)
 proof (induct C arbitrary: q)
   case Hole then show ?case by (intro exI[of _ "\<box>"]) auto
 next
   case (More f ts1 C ts2)
   from More(2) obtain qs q' where q': "f qs \<rightarrow> q' |\<in>| rules \<A>" "q' = q \<or> (q', q) |\<in>| (eps \<A>)|\<^sup>+|"
     "qs ! length ts1 |\<in>| ta_der \<A> (C\<langle>t\<rangle>)" "length qs = Suc (length ts1 + length ts2)"
     by simp (metis less_add_Suc1 nth_append_length)
   { fix i assume "i < length qs"
     then have "qs ! i |\<in>| \<Q> \<A>" using q'(1)
       by (auto dest!: rule_statesD(4))
     then have "\<exists>t. ground t \<and> qs ! i |\<in>| ta_der \<A> t" using assms(1)
       by (simp add: ta_reachable_def) force}
   then obtain ts where ts: "i < length qs \<Longrightarrow> ground (ts i) \<and> qs ! i |\<in>| ta_der \<A> (ts i)" for i by metis
   obtain C' where C: "ground_ctxt C'" "qs ! length ts1 |\<in>| ta_der \<A> C'\<langle>t\<rangle>" using More(1)[OF q'(3)] by blast
   define D where "D \<equiv> More f (map ts [0..<length ts1]) C' (map ts [Suc (length ts1)..<Suc (length ts1 + length ts2)])"
   have "ground_ctxt D" unfolding D_def using ts C(1) q'(4) by auto
   moreover have "q |\<in>| ta_der \<A> D\<langle>t\<rangle>" using ts C(2) q' unfolding D_def
     by (auto simp: nth_append_Cons not_le not_less le_less_Suc_eq Suc_le_eq intro!: exI[of _ qs] exI[of _ q'])
   ultimately show ?case by blast
 qed
 
 lemma ta_productive_def':
   assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>"
   shows "ta_productive Q \<A> = {| q| q q' C. ground_ctxt C \<and> q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| Q |}"
   using ta_productive_aux[OF assms]
   by (auto simp: ta_productive_def intro!: finite_subset[OF _ finite_ta_productive, of _ \<A> Q]) force+
 
 (* turn a finite automaton into a trim one, by removing
    first all unreachable and then all non-productive states *)
 
 lemma trim_gta_lang: "gta_lang Q (trim_ta Q \<A>) = gta_lang Q \<A>"
   unfolding trim_ta_def gta_only_reach_lang gta_only_prod_lang ..
 
 lemma trim_ta_subset: "ta_subset (trim_ta Q \<A>) \<A>"
   unfolding trim_ta_def by (rule ta_prod_reach_subset)
 
 theorem trim_ta: "ta_is_trim Q (trim_ta Q \<A>)" unfolding ta_is_trim_def
   by (metis fin_mono ta_only_prod_reachable ta_only_reach_reachable
       ta_prodictive_ta_only_prod ta_restrict_states_Q trim_ta_def)
 
 
 lemma reg_is_trim_trim_reg [simp]: "reg_is_trim (trim_reg R)"
   unfolding reg_is_trim_def trim_reg_def
   by (simp add: trim_ta)
 
 lemma trim_reg_reach [simp]:
   "\<Q>\<^sub>r (trim_reg A) |\<subseteq>| ta_reachable (ta (trim_reg A))"
   by (auto simp: trim_reg_def) (meson ta_is_trim_def trim_ta)
 
 lemma trim_reg_prod [simp]:
   "\<Q>\<^sub>r (trim_reg A) |\<subseteq>| ta_productive (fin (trim_reg A)) (ta (trim_reg A))"
   by (auto simp: trim_reg_def) (meson ta_is_trim_def trim_ta)
 
 (* Proposition 7: every tree automaton can be turned into an  equivalent trim one *)
 lemmas obtain_trimmed_ta = trim_ta trim_gta_lang ta_subset_det[OF trim_ta_subset]
 
 (* Trim tree automaton signature *)
 lemma \<L>_trim_ta_sig:
   assumes "reg_is_trim R" "\<L> R \<subseteq> \<T>\<^sub>G (fset \<F>)"
   shows "ta_sig (ta R) |\<subseteq>| \<F>"
 proof -
   {fix r assume r: "r |\<in>| rules (ta R)"
     then obtain f ps p where [simp]: "r = f ps \<rightarrow> p" by (cases r) auto
     from r assms(1) have "fset_of_list ps |\<subseteq>| ta_reachable (ta R)"
       by (auto simp add: rule_statesD(4) reg_is_trim_def ta_is_trim_def)
     from ta_reachableI_rule[OF this, of f p] r
     obtain ts where ts: "length ts = length ps" "\<forall> i < length ps. ground (ts ! i)"
       "\<forall> i < length ps. ps ! i |\<in>| ta_der (ta R) (ts ! i)"
       by auto
     obtain C q where ctxt: "ground_ctxt C" "q |\<in>| ta_der (ta R) (C\<langle>Var p\<rangle>)" "q |\<in>| fin R"
       using assms(1) unfolding reg_is_trim_def
       by (metis \<open>r = f ps \<rightarrow> p\<close> fsubsetI r rule_statesD(2) ta_productiveE ta_productive_aux ta_is_trim_def)
     from ts ctxt r have reach: "q |\<in>| ta_der (ta R) C\<langle>Fun f ts\<rangle>"
       by auto (metis ta_der_Fun ta_der_ctxt)
     have gr: "ground C\<langle>Fun f ts\<rangle>" using ts(1, 2) ctxt(1)
       by (auto simp: in_set_conv_nth)
     then have "C\<langle>Fun f ts\<rangle> \<in> ta_lang (fin R) (ta R)" using ctxt(1, 3) ts(1, 2)
       apply (intro ta_langI[OF _ _ reach, of "fin R" "C\<langle>Fun f ts\<rangle>"])
       apply (auto simp del: adapt_vars_ctxt)
       by (metis gr adapt_vars2 adapt_vars_adapt_vars)
     then have *: "gterm_of_term C\<langle>Fun f ts\<rangle> \<in> \<L> R" using gr
       by (auto simp: \<L>_def)
     then have "funas_gterm (gterm_of_term C\<langle>Fun f ts\<rangle>) \<subseteq> fset \<F>" using assms(2) gr
       by (auto simp: \<T>\<^sub>G_equivalent_def)
     moreover have "(f, length ps) \<in> funas_gterm (gterm_of_term C\<langle>Fun f ts\<rangle>)"
       using ts(1) by (auto simp: funas_gterm_gterm_of_term[OF gr])
     ultimately have "(r_root r, length (r_lhs_states r)) |\<in>| \<F>"
       by auto}
   then show ?thesis
     by (auto simp: ta_sig_def)
 qed
 
 text \<open>Map function over TA rules which change states/signature\<close>
 
 lemma map_ta_rule_iff:
   "map_ta_rule f g |`| \<Delta> = {|TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q |\<in>| \<Delta>|}"
   apply (intro fequalityI fsubsetI)
   apply (auto simp add: rev_image_eqI)
   apply (metis map_ta_rule_cases ta_rule.collapse)
   done
 
 lemma \<L>_trim: "\<L> (trim_reg R) = \<L> R"
   by (auto simp: trim_gta_lang \<L>_def trim_reg_def)
 
 
 lemma fmap_funs_ta_def':
   "fmap_funs_ta h \<A> = TA {|(h f) qs \<rightarrow> q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>|} (eps \<A>)"
   unfolding fmap_funs_ta_def map_ta_rule_iff by auto
 
 lemma fmap_states_ta_def':
   "fmap_states_ta h \<A> = TA {|f (map h qs) \<rightarrow> h q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>|} (map_both h |`| eps \<A>)"
   unfolding fmap_states_ta_def map_ta_rule_iff by auto
 
 lemma fmap_states [simp]:
   "\<Q> (fmap_states_ta h \<A>) = h |`| \<Q> \<A>"
   unfolding fmap_states_ta_def \<Q>_def
   by auto
 
 lemma fmap_states_ta_sig [simp]:
   "ta_sig (fmap_states_ta f \<A>) = ta_sig \<A>"
   by (auto simp: fmap_states_ta_def ta_sig_def ta_rule.map_sel intro: fset.map_cong0)
 
 lemma fmap_states_ta_eps_wit:
   assumes "(h p, q) |\<in>| (map_both h |`| eps \<A>)|\<^sup>+|" "finj_on h (\<Q> \<A>)" "p |\<in>| \<Q> \<A>"
-  obtains q' where "q = h q'" "(p, q') |\<in>| (eps \<A>)|\<^sup>+|" "q' |\<in>| \<Q> \<A>" using assms
-  by (auto simp: fimage_iff finj_on_def' ftrancl_map_both_fsubset[OF assms(2), of "eps \<A>"])
-     (metis (mono_tags, lifting) assms(2) eps_trancl_statesD finj_on_eq_iff)
+  obtains q' where "q = h q'" "(p, q') |\<in>| (eps \<A>)|\<^sup>+|" "q' |\<in>| \<Q> \<A>"
+  using assms(1)[unfolded ftrancl_map_both_fsubset[OF assms(2), of "eps \<A>", simplified]]
+  using \<open>finj_on h (\<Q> \<A>)\<close>[unfolded finj_on_def', rule_format, OF \<open>p |\<in>| \<Q> \<A>\<close>]
+  by (metis Pair_inject eps_trancl_statesD prod_fun_fimageE)
 
 lemma ta_der_fmap_states_inv_superset:
   assumes "\<Q> \<A> |\<subseteq>| \<B>" "finj_on h \<B>"
     and  "q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)"
   shows "the_finv_into \<B> h q |\<in>| ta_der \<A> (term_of_gterm t)" using assms(3)
 proof (induct rule: ta_der_gterm_induct)
   case (GFun f ts ps p q)
   from assms(1, 2) have inj: "finj_on h (\<Q> \<A>)" using fsubset_finj_on by blast
   have "x |\<in>| \<Q> \<A> \<Longrightarrow> the_finv_into (\<Q> \<A>) h (h x) = the_finv_into \<B> h (h x)" for x
     using assms(1, 2) by (metis fsubsetD inj the_finv_into_f_f) 
   then show ?case using GFun the_finv_into_f_f[OF inj] assms(1)
     by (auto simp: fmap_states_ta_def' finj_on_def' rule_statesD eps_statesD
       elim!: fmap_states_ta_eps_wit[OF _ inj]
       intro!: exI[of _ "the_finv_into \<B> h p"])
 qed
 
 lemma ta_der_fmap_states_inv:
   assumes "finj_on h (\<Q> \<A>)" "q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)"
   shows "the_finv_into (\<Q> \<A>) h q |\<in>| ta_der \<A> (term_of_gterm t)"
   by (simp add: ta_der_fmap_states_inv_superset assms)
 
 lemma ta_der_to_fmap_states_der:
   assumes "q |\<in>| ta_der \<A> (term_of_gterm t)"
   shows "h q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)" using assms
 proof (induct rule: ta_der_gterm_induct)
   case (GFun f ts ps p q)
   then show ?case
     using ftrancl_map_prod_mono[of h "eps \<A>"]
     by (auto simp: fmap_states_ta_def' intro!: exI[of _ "h p"] exI[of _ "map h ps"])
 qed
 
 lemma ta_der_fmap_states_conv:
   assumes "finj_on h (\<Q> \<A>)"
   shows "ta_der (fmap_states_ta h \<A>) (term_of_gterm t) =  h |`| ta_der \<A> (term_of_gterm t)"
   using ta_der_to_fmap_states_der[of _ \<A> t] ta_der_fmap_states_inv[OF assms]
   using f_the_finv_into_f[OF assms] finj_on_the_finv_into[OF assms]
   using gterm_ta_der_states
   by (auto intro!: rev_fimage_eqI) fastforce
 
 lemma fmap_states_ta_det:
   assumes "finj_on f (\<Q> \<A>)"
   shows "ta_det (fmap_states_ta f \<A>) = ta_det \<A>" (is "?Ls = ?Rs")
 proof
   {fix g ps p q assume ass: "?Ls" "TA_rule g ps p |\<in>| rules \<A>" "TA_rule g ps q |\<in>| rules \<A>"
     then have "TA_rule g (map f ps) (f p) |\<in>| rules (fmap_states_ta f \<A>)"
        "TA_rule g (map f ps) (f q) |\<in>| rules (fmap_states_ta f \<A>)"
       by (force simp: fmap_states_ta_def)+
     then have "p = q" using ass finj_on_eq_iff[OF assms]
       by (auto simp: ta_det_def) (meson rule_statesD(2))} 
   then show "?Ls \<Longrightarrow> ?Rs"
     by (auto simp: ta_det_def fmap_states_ta_def')
 next
   {fix g ps qs p q assume ass: "?Rs" "TA_rule g ps p |\<in>| rules \<A>" "TA_rule g qs q |\<in>| rules \<A>"
     then have "map f ps = map f qs \<Longrightarrow> ps = qs" using finj_on_eq_iff[OF assms]
       by (auto simp: map_eq_nth_conv in_fset_conv_nth dest!: rule_statesD(4) intro!: nth_equalityI)}
   then show "?Rs \<Longrightarrow> ?Ls" using finj_on_eq_iff[OF assms]
     by (auto simp: ta_det_def fmap_states_ta_def') blast
 qed
 
 lemma fmap_states_ta_lang:
   "finj_on f (\<Q> \<A>) \<Longrightarrow> Q |\<subseteq>| \<Q> \<A> \<Longrightarrow> gta_lang (f |`| Q) (fmap_states_ta f \<A>) = gta_lang Q \<A>"
   using ta_der_fmap_states_conv[of f \<A>]
   by (auto simp: finj_on_def' finj_on_eq_iff fsubsetD elim!: gta_langE intro!: gta_langI)
 
 lemma fmap_states_ta_lang2:
   "finj_on f (\<Q> \<A> |\<union>| Q) \<Longrightarrow> gta_lang (f |`| Q) (fmap_states_ta f \<A>) = gta_lang Q \<A>"
   using ta_der_fmap_states_conv[OF fsubset_finj_on[of f "\<Q> \<A> |\<union>| Q" "\<Q> \<A>"]] 
   by (auto simp: finj_on_def' elim!: gta_langE intro!: gta_langI) fastforce
 
 
 definition funs_ta :: "('q, 'f) ta \<Rightarrow> 'f fset" where
   "funs_ta \<A> = {|f |f qs q. TA_rule f qs q |\<in>| rules \<A>|}"
 
 lemma funs_ta[code]:
   "funs_ta \<A> = (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> f) |`| (rules \<A>)" (is "?Ls = ?Rs")
   by (force simp: funs_ta_def rev_fimage_eqI simp flip: fset.set_map
      split!: ta_rule.splits intro!: finite_subset[of "{f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}" "fset ?Rs"])
 
 lemma finite_funs_ta [simp]:
   "finite {f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}"
   by (intro finite_subset[of "{f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}" "fset (funs_ta \<A>)"])
      (auto simp: funs_ta rev_fimage_eqI simp flip: fset.set_map split!: ta_rule.splits)
 
 lemma funs_taE [elim]:
   assumes "f |\<in>| funs_ta \<A>"
   obtains ps p where "TA_rule f ps p |\<in>| rules \<A>" using assms
   by (auto simp: funs_ta_def)
 
 lemma funs_taI [intro]:
   "TA_rule f ps p |\<in>| rules \<A> \<Longrightarrow> f |\<in>| funs_ta \<A>"
   by (auto simp: funs_ta_def)
 
 lemma fmap_funs_ta_cong:
   "(\<And>x. x |\<in>| funs_ta \<A> \<Longrightarrow> h x = k x) \<Longrightarrow> \<A> = \<B> \<Longrightarrow> fmap_funs_ta h \<A> = fmap_funs_ta k \<B>"
   by (force simp: fmap_funs_ta_def')
 
 lemma [simp]: "{|TA_rule f qs q |f qs q. TA_rule f qs q |\<in>| X|} = X"
   by (intro fset_eqI; case_tac x) auto
 
 lemma fmap_funs_ta_id [simp]:
   "fmap_funs_ta id \<A> = \<A>" by (simp add: fmap_funs_ta_def')
 
 lemma fmap_states_ta_id [simp]:
   "fmap_states_ta id \<A> = \<A>"
   by (auto simp: fmap_states_ta_def map_ta_rule_iff prod.map_id0)
 
 lemmas fmap_funs_ta_id' [simp] = fmap_funs_ta_id[unfolded id_def]
 
 lemma fmap_funs_ta_comp:
   "fmap_funs_ta h (fmap_funs_ta k A) = fmap_funs_ta (h \<circ> k) A"
 proof -
   have "r |\<in>| rules A \<Longrightarrow> map_ta_rule id h (map_ta_rule id k r) = map_ta_rule id (\<lambda>x. h (k x)) r" for r
     by (cases r) (auto)
   then show ?thesis
     by (force simp: fmap_funs_ta_def fimage_iff cong: fmap_funs_ta_cong)
 qed
 
 lemma fmap_funs_reg_comp:
   "fmap_funs_reg h (fmap_funs_reg k A) = fmap_funs_reg (h \<circ> k) A"
   using fmap_funs_ta_comp unfolding fmap_funs_reg_def
   by auto
 
 lemma fmap_states_ta_comp:
   "fmap_states_ta h (fmap_states_ta k A) = fmap_states_ta (h \<circ> k) A"
   by (auto simp: fmap_states_ta_def ta_rule.map_comp comp_def id_def prod.map_comp)
 
 lemma funs_ta_fmap_funs_ta [simp]:
   "funs_ta (fmap_funs_ta f A) = f |`| funs_ta A"
   by (auto simp: funs_ta fmap_funs_ta_def' comp_def fimage_iff
     split!: ta_rule.splits) force+
 
 lemma ta_der_funs_ta:
   "q |\<in>| ta_der A t \<Longrightarrow> ffuns_term t |\<subseteq>| funs_ta A"
 proof (induct t arbitrary: q)
   case (Fun f ts)
   then have "f |\<in>| funs_ta A" by (auto simp: funs_ta_def)
   then show ?case using Fun(1)[OF nth_mem, THEN fsubsetD] Fun(2)
     by (auto simp: in_fset_conv_nth) blast+
 qed auto
 
 lemma ta_der_fmap_funs_ta:
   "q |\<in>| ta_der A t \<Longrightarrow> q |\<in>| ta_der (fmap_funs_ta f A) (map_funs_term f t)"
   by (induct t arbitrary: q) (auto 0 4 simp: fmap_funs_ta_def')
 
 lemma ta_der_fmap_states_ta:
   assumes "q |\<in>| ta_der A t"
   shows "h q |\<in>| ta_der (fmap_states_ta h A) (map_vars_term h t)"
 proof -
   have [intro]: "(q, q') |\<in>| (eps A)|\<^sup>+| \<Longrightarrow> (h q, h q') |\<in>| (eps (fmap_states_ta h A))|\<^sup>+|" for q q'
     by (force intro!: ftrancl_map[of "eps A"] simp: fmap_states_ta_def)
   show ?thesis using assms
   proof (induct rule: ta_der_induct)
     case (Fun f ts ps p q)
     have "f (map h ps) \<rightarrow> h p |\<in>| rules (fmap_states_ta h A)"
       using Fun(1) by (force simp: fmap_states_ta_def')
     then show ?case using Fun by (auto 0 4)
   qed auto
 qed
 
 lemma ta_der_fmap_states_ta_mono:
   shows "f |`| ta_der A (term_of_gterm s) |\<subseteq>| ta_der (fmap_states_ta f A) (term_of_gterm s)"
   using ta_der_fmap_states_ta[of _ A "term_of_gterm s" f]
   by (simp add: fimage_fsubsetI ta_der_to_fmap_states_der)
 
 lemma ta_der_fmap_states_ta_mono2:
   assumes "finj_on f (\<Q> A)"
   shows "ta_der (fmap_states_ta f A) (term_of_gterm s) |\<subseteq>| f |`| ta_der A (term_of_gterm s)"
   using ta_der_fmap_states_conv[OF assms] by auto
 
 lemma fmap_funs_ta_der':
   "q |\<in>| ta_der (fmap_funs_ta h A) t \<Longrightarrow> \<exists>t'. q |\<in>| ta_der A t' \<and> map_funs_term h t' = t"
 proof (induct rule: ta_der_induct)
   case (Var q v)
   then show ?case by (auto simp: fmap_funs_ta_def intro!: exI[of _ "Var v"])
 next
   case (Fun f ts ps p q)
   obtain f' ts' where root: "f = h f'" "f' ps \<rightarrow> p |\<in>| rules A" and
     "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der A (ts' i) \<and> map_funs_term h (ts' i) = ts ! i"
     using Fun(1, 5) unfolding fmap_funs_ta_def'
     by auto metis
   note [simp] = conjunct1[OF this(3)] conjunct2[OF this(3), unfolded id_def]
   have [simp]: "p = q \<Longrightarrow> f' ps \<rightarrow> q |\<in>| rules A" using root(2) by auto
   show ?case using Fun(3)
     by (auto simp: comp_def Fun root fmap_funs_ta_def'
       intro!: exI[of _ "Fun f' (map ts' [0..<length ts])"] exI[of _ ps] exI[of _ p] nth_equalityI)
 qed
 
 lemma fmap_funs_gta_lang:
   "gta_lang Q (fmap_funs_ta h \<A>) = map_gterm h ` gta_lang Q \<A>" (is "?Ls = ?Rs")
 proof -
   {fix s assume "s \<in> ?Ls" then obtain q where
     lang: "q |\<in>| Q" "q |\<in>| ta_der (fmap_funs_ta h \<A>) (term_of_gterm s)"
       by auto
     from fmap_funs_ta_der'[OF this(2)] obtain t where
     t: "q |\<in>| ta_der \<A> t" "map_funs_term h t = term_of_gterm s" "ground t"
       by (metis ground_map_term ground_term_of_gterm)
     then have "s \<in> ?Rs" using map_gterm_of_term[OF t(3), of h id] lang
       by (auto simp: gta_lang_def gta_der_def image_iff)
          (metis fempty_iff finterI ground_term_to_gtermD map_term_of_gterm term_of_gterm_inv)}
   moreover have "?Rs \<subseteq> ?Ls" using ta_der_fmap_funs_ta[of _ \<A> _ h]
     by (auto elim!: gta_langE intro!: gta_langI) fastforce
   ultimately show ?thesis by blast
 qed
 
 lemma fmap_funs_\<L>:
   "\<L> (fmap_funs_reg h R) =  map_gterm h ` \<L> R"
   using fmap_funs_gta_lang[of "fin R" h]
   by (auto simp: fmap_funs_reg_def \<L>_def)
 
 lemma ta_states_fmap_funs_ta [simp]: "\<Q> (fmap_funs_ta f A) = \<Q> A"
   by (auto simp: fmap_funs_ta_def \<Q>_def)
  
 lemma ta_reachable_fmap_funs_ta [simp]:
   "ta_reachable (fmap_funs_ta f A) = ta_reachable A" unfolding ta_reachable_def
   by (metis (mono_tags, lifting) fmap_funs_ta_der' ta_der_fmap_funs_ta ground_map_term)
 
 
 lemma fin_in_states:
   "fin (reg_Restr_Q\<^sub>f R) |\<subseteq>| \<Q>\<^sub>r (reg_Restr_Q\<^sub>f R)"
   by (auto simp: reg_Restr_Q\<^sub>f_def)
 
 lemma fmap_states_reg_Restr_Q\<^sub>f_fin:
   "finj_on f (\<Q> \<A>) \<Longrightarrow> fin (fmap_states_reg f (reg_Restr_Q\<^sub>f R)) |\<subseteq>| \<Q>\<^sub>r (fmap_states_reg f (reg_Restr_Q\<^sub>f R))"
   by (auto simp: fmap_states_reg_def reg_Restr_Q\<^sub>f_def)
 
 lemma \<L>_fmap_states_reg_Inl_Inr [simp]:
   "\<L> (fmap_states_reg Inl R) = \<L> R"
   "\<L> (fmap_states_reg Inr R) = \<L> R"
   unfolding \<L>_def fmap_states_reg_def
   by (auto simp: finj_Inl_Inr intro!: fmap_states_ta_lang2)
 
 lemma finite_Collect_prod_ta_rules:
   "finite {f qs \<rightarrow> (a, b) |f qs a b. f map fst qs \<rightarrow> a |\<in>| rules \<A> \<and> f map snd qs \<rightarrow> b |\<in>| rules \<BB>}" (is "finite ?set")
 proof -
   have "?set \<subseteq> (\<lambda> (ra, rb). case ra of f ps \<rightarrow> p \<Rightarrow> case rb of g qs \<rightarrow> q \<Rightarrow> f (zip ps qs) \<rightarrow> (p, q)) ` (srules \<A> \<times> srules \<BB>)"
     by (auto simp: srules_def image_iff split!: ta_rule.splits)
        (metis ta_rule.inject zip_map_fst_snd)
   from finite_imageI[of "srules \<A> \<times> srules \<BB>", THEN finite_subset[OF this]]
   show ?thesis by (auto simp: srules_def)
 qed
 
 \<comment> \<open>The product automaton of the automata A and B is constructed
  by applying the rules on pairs of states\<close>
 
 lemmas prod_eps_def = prod_epsLp_def prod_epsRp_def
 
 lemma finite_prod_epsLp:
   "finite (Collect (prod_epsLp \<A> \<B>))"
   by (intro finite_subset[of "Collect (prod_epsLp \<A> \<B>)" "fset ((\<Q> \<A> |\<times>| \<Q> \<B>) |\<times>| \<Q> \<A> |\<times>| \<Q> \<B>)"])
      (auto simp: prod_epsLp_def dest: eps_statesD)
 
 lemma finite_prod_epsRp:
   "finite (Collect (prod_epsRp \<A> \<B>))"
   by (intro finite_subset[of "Collect (prod_epsRp \<A> \<B>)" "fset ((\<Q> \<A> |\<times>| \<Q> \<B>) |\<times>| \<Q> \<A> |\<times>| \<Q> \<B>)"])
      (auto simp: prod_epsRp_def dest: eps_statesD)
 lemmas finite_prod_eps [simp] = finite_prod_epsLp[unfolded prod_epsLp_def] finite_prod_epsRp[unfolded prod_epsRp_def]
 
 lemma [simp]: "f qs \<rightarrow> q |\<in>| rules (prod_ta \<A> \<B>) \<longleftrightarrow> f qs \<rightarrow> q |\<in>| prod_ta_rules \<A> \<B>"
   "r |\<in>| rules (prod_ta \<A> \<B>) \<longleftrightarrow> r |\<in>| prod_ta_rules \<A> \<B>"
   by (auto simp: prod_ta_def)
 
 lemma prod_ta_states:
   "\<Q> (prod_ta \<A> \<B>) |\<subseteq>| \<Q> \<A> |\<times>| \<Q> \<B>"
 proof -
   {fix q assume "q |\<in>| rule_states (rules (prod_ta \<A> \<B>))"
     then obtain f ps p where "f ps \<rightarrow> p |\<in>| rules (prod_ta \<A> \<B>)" and "q |\<in>| fset_of_list ps \<or> p = q"
       by (metis rule_statesE)
     then have "fst q |\<in>| \<Q> \<A> \<and> snd q |\<in>| \<Q> \<B>"
       using rule_statesD(2, 4)[of f "map fst ps" "fst p" \<A>]
       using rule_statesD(2, 4)[of f "map snd ps" "snd p" \<B>]
       by auto}
   moreover
   {fix q assume "q |\<in>| eps_states (eps (prod_ta \<A> \<B>))" then have "fst q |\<in>| \<Q> \<A> \<and> snd q |\<in>| \<Q> \<B>"
       by (auto simp: eps_states_def prod_ta_def prod_eps_def dest: eps_statesD)}
   ultimately show ?thesis
     by (auto simp: \<Q>_def) blast+
 qed
 
 lemma prod_ta_det:
   assumes "ta_det \<A>" and "ta_det \<B>"
   shows "ta_det (prod_ta \<A> \<B>)"
   using assms unfolding ta_det_def prod_ta_def prod_eps_def
   by auto
 
 lemma prod_ta_sig:
   "ta_sig (prod_ta \<A> \<B>) |\<subseteq>| ta_sig \<A> |\<union>| ta_sig \<B>"
 proof (rule fsubsetI)
   fix x
   assume "x |\<in>| ta_sig (prod_ta \<A> \<B>)"
   hence "x |\<in>| ta_sig \<A> \<or> x |\<in>| ta_sig \<B>"
     unfolding ta_sig_def prod_ta_def
     using image_iff by fastforce
   thus "x |\<in>| ta_sig (prod_ta \<A> \<B>) \<Longrightarrow> x |\<in>| ta_sig \<A> |\<union>| ta_sig \<B>"
     by simp
 qed
 
 lemma from_prod_eps:
   "(p, q) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+| \<Longrightarrow> (snd p, snd q) |\<notin>| (eps \<B>)|\<^sup>+| \<Longrightarrow> snd p = snd q \<and> (fst p, fst q) |\<in>| (eps \<A>)|\<^sup>+|"
   "(p, q) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+| \<Longrightarrow> (fst p, fst q) |\<notin>| (eps \<A>)|\<^sup>+| \<Longrightarrow> fst p = fst q \<and> (snd p, snd q) |\<in>| (eps \<B>)|\<^sup>+|"
   apply (induct rule: ftrancl_induct) 
   apply (auto simp: prod_ta_def prod_eps_def intro: ftrancl_into_trancl )
   apply (simp add: fr_into_trancl not_ftrancl_into)+
   done
 
 lemma to_prod_eps\<A>:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> r |\<in>| \<Q> \<B> \<Longrightarrow> ((p, r), (q, r)) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|"
   by (induct rule: ftrancl_induct)
      (auto simp: prod_ta_def prod_eps_def intro: fr_into_trancl ftrancl_into_trancl)
 
 lemma to_prod_eps\<B>:
   "(p, q) |\<in>| (eps \<B>)|\<^sup>+| \<Longrightarrow> r |\<in>| \<Q> \<A> \<Longrightarrow> ((r, p), (r, q)) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|"
   by (induct rule: ftrancl_induct)
      (auto simp: prod_ta_def prod_eps_def intro: fr_into_trancl ftrancl_into_trancl)
 
 lemma to_prod_eps:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> (p', q') |\<in>| (eps \<B>)|\<^sup>+| \<Longrightarrow> ((p, p'), (q, q')) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|"
 proof (induct rule: ftrancl_induct)
   case (Base a b)
   show ?case using Base(2, 1)
   proof (induct rule: ftrancl_induct)
     case (Base c d)
     then have "((a, c), b, c) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|" using finite_prod_eps
       by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl ftrancl_into_trancl)
     moreover have "((b, c), b, d) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|" using finite_prod_eps Base
       by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl ftrancl_into_trancl)
     ultimately show ?case
       by (auto intro: ftrancl_trans)
   next
     case (Step p q r)
     then have "((b, q), b, r) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|" using finite_prod_eps
       by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl)
     then show ?case using Step
       by (auto intro: ftrancl_trans)
   qed
 next
   case (Step a b c)
   from Step have "q' |\<in>| \<Q> \<B>"
     by (auto dest: eps_trancl_statesD)
   then have "((b, q'), (c,q')) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|" 
     using Step(3) finite_prod_eps
     by (auto simp: prod_ta_def prod_eps_def intro!: fr_into_trancl)
   then show ?case using ftrancl_trans Step
     by auto
 qed
 
 lemma prod_ta_der_to_\<A>_\<B>_der1:
   assumes "q |\<in>| ta_der (prod_ta \<A> \<B>) (term_of_gterm t)"
   shows "fst q |\<in>| ta_der \<A> (term_of_gterm t)" using assms
 proof (induct rule: ta_der_gterm_induct)
   case (GFun f ts ps p q)
   then show ?case
     by (auto dest: from_prod_eps intro!: exI[of _ "map fst ps"] exI[of _ "fst p"])
 qed
 
 lemma prod_ta_der_to_\<A>_\<B>_der2:
   assumes "q |\<in>| ta_der (prod_ta \<A> \<B>) (term_of_gterm t)"
   shows  "snd q |\<in>| ta_der \<B> (term_of_gterm t)" using assms
 proof (induct rule: ta_der_gterm_induct)
   case (GFun f ts ps p q)
   then show ?case
     by (auto dest: from_prod_eps intro!: exI[of _ "map snd ps"] exI[of _ "snd p"])
 qed
 
 lemma \<A>_\<B>_der_to_prod_ta:
   assumes "fst q |\<in>| ta_der \<A> (term_of_gterm t)" "snd q |\<in>| ta_der \<B> (term_of_gterm t)"
   shows "q |\<in>| ta_der (prod_ta \<A> \<B>) (term_of_gterm t)" using assms
 proof (induct t arbitrary: q)
   case (GFun f ts)
   from GFun(2, 3) obtain ps qs p q' where
     rules: "f ps \<rightarrow> p |\<in>| rules \<A>" "f qs \<rightarrow> q' |\<in>| rules \<B>" "length ps = length ts" "length ps = length qs" and
     eps: "p = fst q \<or> (p, fst q) |\<in>| (eps \<A>)|\<^sup>+|" "q' = snd q \<or> (q', snd q) |\<in>| (eps \<B>)|\<^sup>+|" and
     steps: "\<forall> i < length qs. ps ! i |\<in>| ta_der \<A> (term_of_gterm (ts ! i))"
       "\<forall> i < length qs. qs ! i |\<in>| ta_der \<B> (term_of_gterm (ts ! i))"
     by auto
   from rules have st: "p |\<in>| \<Q> \<A>" "q' |\<in>| \<Q> \<B>" by (auto dest: rule_statesD)
   have "(p, snd q) = q \<or> ((p, q'), q) |\<in>| (eps (prod_ta \<A> \<B>))|\<^sup>+|" using eps st
     using to_prod_eps\<B>[of q' "snd q" \<B> "fst q" \<A>]
     using to_prod_eps\<A>[of p "fst q" \<A> "snd q" \<B>]
     using to_prod_eps[of p "fst q" \<A> q' "snd q" \<B>]
     by (cases "p = fst q"; cases "q' = snd q") (auto simp: prod_ta_def)
   then show ?case using rules eps steps GFun(1) st
     by (cases "(p, snd q) = q")
        (auto simp: finite_Collect_prod_ta_rules dest: to_prod_eps\<B> intro!: exI[of _ p] exI[of _ q'] exI[of _ "zip ps qs"])
 qed
 
 lemma prod_ta_der:
   "q |\<in>| ta_der (prod_ta \<A> \<B>) (term_of_gterm t) \<longleftrightarrow>
      fst q |\<in>| ta_der \<A> (term_of_gterm t) \<and> snd q |\<in>| ta_der \<B> (term_of_gterm t)"
   using prod_ta_der_to_\<A>_\<B>_der1 prod_ta_der_to_\<A>_\<B>_der2 \<A>_\<B>_der_to_prod_ta
   by blast
 
 lemma intersect_ta_gta_lang:
  "gta_lang (Q\<^sub>\<A> |\<times>| Q\<^sub>\<B>) (prod_ta \<A> \<B>) = gta_lang Q\<^sub>\<A> \<A> \<inter> gta_lang Q\<^sub>\<B> \<B>"
   by (auto simp: prod_ta_der elim!: gta_langE intro: gta_langI)
 
 
 lemma \<L>_intersect: "\<L> (reg_intersect R L) = \<L> R \<inter> \<L> L"
   by (auto simp: intersect_ta_gta_lang \<L>_def reg_intersect_def)
 
 lemma intersect_ta_ta_lang:
  "ta_lang (Q\<^sub>\<A> |\<times>| Q\<^sub>\<B>) (prod_ta \<A> \<B>) = ta_lang Q\<^sub>\<A> \<A> \<inter> ta_lang Q\<^sub>\<B> \<B>"
   using intersect_ta_gta_lang[of Q\<^sub>\<A> Q\<^sub>\<B> \<A> \<B>]
   by auto (metis IntI imageI term_of_gterm_inv)
 
 \<comment>  \<open>Union of tree automata\<close>
 
 lemma ta_union_ta_subset:
   "ta_subset \<A> (ta_union \<A> \<B>)" "ta_subset \<B> (ta_union \<A> \<B>)"
   unfolding ta_subset_def ta_union_def
   by auto
 
 lemma ta_union_states [simp]:
   "\<Q> (ta_union \<A> \<B>) = \<Q> \<A> |\<union>| \<Q> \<B>"
   by (auto simp: ta_union_def \<Q>_def)
 
 lemma ta_union_sig [simp]:
   "ta_sig (ta_union \<A> \<B>) = ta_sig \<A> |\<union>| ta_sig \<B>"
   by (auto simp: ta_union_def ta_sig_def)
 
 lemma ta_union_eps_disj_states:
   assumes "\<Q> \<A> |\<inter>| \<Q> \<B> = {||}" and "(p, q) |\<in>| (eps (ta_union \<A> \<B>))|\<^sup>+|"
   shows "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<or> (p, q) |\<in>| (eps \<B>)|\<^sup>+|" using assms(2, 1)
   by (induct rule: ftrancl_induct)
      (auto simp: ta_union_def ftrancl_into_trancl dest: eps_statesD eps_trancl_statesD)
 
 lemma eps_ta_union_eps [simp]:
   "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> (p, q) |\<in>| (eps (ta_union \<A> \<B>))|\<^sup>+|"
   "(p, q) |\<in>| (eps \<B>)|\<^sup>+| \<Longrightarrow> (p, q) |\<in>| (eps (ta_union \<A> \<B>))|\<^sup>+|"
   by (auto simp add: in_ftrancl_UnI ta_union_def)
 
 
 lemma disj_states_eps [simp]:
   "\<Q> \<A> |\<inter>| \<Q> \<B> = {||} \<Longrightarrow> f ps \<rightarrow> p |\<in>| rules \<A> \<Longrightarrow> (p, q) |\<in>| (eps \<B>)|\<^sup>+| \<longleftrightarrow> False"
   "\<Q> \<A> |\<inter>| \<Q> \<B> = {||} \<Longrightarrow> f ps \<rightarrow> p |\<in>| rules \<B> \<Longrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<longleftrightarrow>  False"
   by (auto simp: rtrancl_eq_or_trancl dest: rule_statesD eps_trancl_statesD)
 
 lemma ta_union_der_disj_states:
   assumes "\<Q> \<A> |\<inter>| \<Q> \<B> = {||}" and "q |\<in>| ta_der (ta_union \<A> \<B>) t"
   shows "q |\<in>| ta_der \<A> t \<or> q |\<in>| ta_der \<B> t" using assms(2)
 proof (induct rule: ta_der_induct)
   case (Var q v)
   then show ?case using ta_union_eps_disj_states[OF assms(1)]
     by auto
 next
   case (Fun f ts ps p q)
   have dist: "fset_of_list ps |\<subseteq>| \<Q> \<A> \<Longrightarrow> i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (ts ! i)"
     "fset_of_list ps |\<subseteq>| \<Q> \<B> \<Longrightarrow> i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<B> (ts ! i)" for i
     using Fun(2) Fun(5)[of i] assms(1)
     by (auto dest!: ta_der_not_stateD fsubsetD)
   from Fun(1) consider (a) "fset_of_list ps |\<subseteq>| \<Q> \<A>" | (b) "fset_of_list ps |\<subseteq>| \<Q> \<B>"
     by (auto simp: ta_union_def dest: rule_statesD)
   then show ?case using dist Fun(1, 2) assms(1) ta_union_eps_disj_states[OF assms(1), of p q] Fun(3)
     by (cases) (auto simp: fsubsetI rule_statesD ta_union_def intro!: exI[of _ p] exI[of _ ps])   
 qed
 
 lemma ta_union_der_disj_states':
   assumes "\<Q> \<A> |\<inter>| \<Q> \<B> = {||}"
   shows "ta_der (ta_union \<A> \<B>) t = ta_der \<A> t |\<union>| ta_der \<B> t"
   using ta_union_der_disj_states[OF assms] ta_der_mono' ta_union_ta_subset
   by (auto, fastforce) blast
 
 lemma ta_union_gta_lang:
   assumes "\<Q> \<A> |\<inter>| \<Q> \<B> = {||}" and "Q\<^sub>\<A> |\<subseteq>| \<Q> \<A>" and "Q\<^sub>\<B> |\<subseteq>| \<Q> \<B>"
   shows"gta_lang (Q\<^sub>\<A> |\<union>| Q\<^sub>\<B>) (ta_union \<A> \<B>) = gta_lang Q\<^sub>\<A> \<A> \<union> gta_lang Q\<^sub>\<B> \<B>" (is "?Ls = ?Rs")
 proof -
   {fix s assume "s \<in> ?Ls" then obtain q
       where w: "q |\<in>| Q\<^sub>\<A> |\<union>| Q\<^sub>\<B>" "q |\<in>| ta_der (ta_union \<A> \<B>) (term_of_gterm s)"
       by (auto elim: gta_langE)
     from ta_union_der_disj_states[OF assms(1) w(2)] consider
       (a)  "q |\<in>| ta_der \<A> (term_of_gterm s)" | "q |\<in>| ta_der \<B> (term_of_gterm s)" by blast
     then have "s \<in> ?Rs" using w(1) assms
       by (cases, auto simp: gta_langI)
          (metis fempty_iff finterI funion_iff gterm_ta_der_states sup.orderE)}
   moreover have "?Rs \<subseteq> ?Ls" using ta_union_der_disj_states'[OF assms(1)]
     by (auto elim!: gta_langE intro!: gta_langI)
   ultimately show ?thesis by blast
 qed
 
 
 lemma \<L>_union: "\<L> (reg_union R L) = \<L> R \<union> \<L> L"
 proof -
   let ?inl = "Inl :: 'b \<Rightarrow> 'b + 'c" let ?inr = "Inr :: 'c \<Rightarrow> 'b + 'c"
   let ?fr = "?inl |`| (fin R |\<inter>| \<Q>\<^sub>r R)" let ?fl = "?inr |`| (fin L |\<inter>| \<Q>\<^sub>r L)"
   have [simp]:"gta_lang (?fr |\<union>| ?fl) (ta_union (fmap_states_ta ?inl (ta R)) (fmap_states_ta ?inr (ta L))) =
    gta_lang ?fr (fmap_states_ta ?inl (ta R)) \<union> gta_lang ?fl (fmap_states_ta ?inr (ta L))"
     by (intro ta_union_gta_lang) (auto simp: fimage_iff)
   have [simp]: "gta_lang ?fr (fmap_states_ta ?inl (ta R)) = gta_lang (fin R |\<inter>| \<Q>\<^sub>r R) (ta R)"
     by (intro fmap_states_ta_lang) (auto simp: finj_Inl_Inr)
   have [simp]: "gta_lang ?fl (fmap_states_ta ?inr (ta L)) = gta_lang (fin L |\<inter>| \<Q>\<^sub>r L) (ta L)"
     by (intro fmap_states_ta_lang) (auto simp: finj_Inl_Inr)
   show ?thesis
     using gta_lang_Rest_states_conv
     by (auto simp: \<L>_def reg_union_def ta_union_gta_lang) fastforce
 qed
 
 lemma reg_union_states:
   "\<Q>\<^sub>r (reg_union A B) = (Inl |`| \<Q>\<^sub>r A) |\<union>| (Inr |`| \<Q>\<^sub>r B)"
   by (auto simp: reg_union_def)
 
 \<comment> \<open>Deciding emptiness\<close>
 
 lemma ta_empty [simp]:
   "ta_empty Q \<A> = (gta_lang Q \<A> = {})"
   by (auto simp: ta_empty_def elim!: gta_langE ta_reachable_gtermE
     intro: ta_reachable_gtermI gta_langI)
 
 
 lemma reg_empty [simp]:
   "reg_empty R = (\<L> R = {})"
   by (simp add: \<L>_def reg_empty_def)
 
 text \<open>Epsilon free automaton\<close>
 
 lemma finite_eps_free_rulep [simp]:
   "finite (Collect (eps_free_rulep \<A>))"
 proof -
   let ?par = "(\<lambda> r. case r of f qs \<rightarrow> q \<Rightarrow> (f, qs)) |`| (rules \<A>)"
   let ?st = "(\<lambda> (r, q). case r of (f, qs) \<Rightarrow> TA_rule f qs q) |`| (?par |\<times>| \<Q> \<A>)"
   show ?thesis using rule_statesD eps_trancl_statesD
     by (intro finite_subset[of "Collect (eps_free_rulep \<A>)" "fset ?st"])
        (auto simp: eps_free_rulep_def fimage_iff
              simp flip: fset.set_map
              split!: ta_rule.splits, fastforce+)
 qed
 
 lemmas finite_eps_free_rule [simp] = finite_eps_free_rulep[unfolded eps_free_rulep_def]
 
 lemma ta_res_eps_free:
   "ta_der (eps_free \<A>) (term_of_gterm t) = ta_der \<A> (term_of_gterm t)" (is "?Ls = ?Rs")
 proof -
   {fix q assume "q |\<in>| ?Ls" then have "q |\<in>| ?Rs"
       by (induct rule: ta_der_gterm_induct)
          (auto simp: eps_free_def eps_free_rulep_def)}
   moreover
   {fix q assume "q |\<in>| ?Rs" then have "q |\<in>| ?Ls"
     proof (induct rule: ta_der_gterm_induct)
       case (GFun f ts ps p q)
       then show ?case
         by (auto simp: eps_free_def eps_free_rulep_def intro!: exI[of _ ps])
     qed}
   ultimately show ?thesis by blast
 qed
 
 lemma ta_lang_eps_free [simp]:
   "gta_lang Q (eps_free \<A>) = gta_lang Q \<A>"
   by (auto simp add: ta_res_eps_free elim!: gta_langE intro: gta_langI)
 
 lemma \<L>_eps_free: "\<L> (eps_free_reg R) = \<L> R"
   by (auto simp: \<L>_def eps_free_reg_def)
 
 text \<open>Sufficient criterion for containment\<close>
   (* sufficient criterion to check whether automaton accepts at least T_g(F) where F is a subset of
    the signature *) 
 
 definition ta_contains_aux :: "('f \<times> nat) set \<Rightarrow> 'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> 'q fset \<Rightarrow> bool" where
   "ta_contains_aux \<F> Q\<^sub>1 \<A> Q\<^sub>2 \<equiv> (\<forall> f qs. (f, length qs) \<in> \<F> \<and> fset_of_list qs |\<subseteq>| Q\<^sub>1 \<longrightarrow>
      (\<exists> q q'. TA_rule f qs q |\<in>| rules \<A> \<and> q' |\<in>| Q\<^sub>2 \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|)))"
 
 lemma ta_contains_aux_state_set:
   assumes "ta_contains_aux \<F> Q \<A> Q" "t \<in> \<T>\<^sub>G \<F>"
   shows "\<exists> q. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm t)" using assms(2)
 proof (induct rule: \<T>\<^sub>G.induct)
   case (const a)
   then show ?case using assms(1)
     by (force simp: ta_contains_aux_def)
 next
   case (ind f n ss)
   obtain qs where "fset_of_list qs |\<subseteq>| Q" "length ss = length qs"
     "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"
     using ind(4) Ex_list_of_length_P[of "length ss" "\<lambda> q i. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"]
     by (auto simp: fset_list_fsubset_eq_nth_conv) metis
   then show ?case using ind(1 - 3) assms(1)
     by (auto simp: ta_contains_aux_def) blast
 qed
 
 lemma ta_contains_aux_mono:
   assumes "ta_subset \<A> \<B>" and "Q\<^sub>2 |\<subseteq>| Q\<^sub>2'"
   shows "ta_contains_aux \<F> Q\<^sub>1 \<A> Q\<^sub>2 \<Longrightarrow> ta_contains_aux \<F> Q\<^sub>1 \<B> Q\<^sub>2'"
   using assms unfolding ta_contains_aux_def ta_subset_def
   by (meson fin_mono ftrancl_mono)
  
 definition ta_contains :: "('f \<times> nat) set \<Rightarrow> ('f \<times> nat) set \<Rightarrow> ('q, 'f) ta \<Rightarrow> 'q fset \<Rightarrow> 'q fset \<Rightarrow> bool"
   where "ta_contains \<F> \<G> \<A> Q Q\<^sub>f \<equiv> ta_contains_aux \<F> Q \<A> Q \<and> ta_contains_aux \<G> Q \<A> Q\<^sub>f"
 
 lemma ta_contains_mono:
   assumes "ta_subset \<A> \<B>" and "Q\<^sub>f |\<subseteq>| Q\<^sub>f'"
   shows "ta_contains \<F> \<G> \<A> Q Q\<^sub>f \<Longrightarrow> ta_contains \<F> \<G> \<B> Q Q\<^sub>f'"
   unfolding ta_contains_def 
   using ta_contains_aux_mono[OF assms(1) fsubset_refl]
   using ta_contains_aux_mono[OF assms]
   by blast
 
 lemma ta_contains_both: 
   assumes contain: "ta_contains \<F> \<G> \<A> Q Q\<^sub>f"
   shows "\<And> t. groot t \<in> \<G> \<Longrightarrow> \<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F> \<Longrightarrow> t \<in> gta_lang Q\<^sub>f \<A>"
 proof -
   fix t :: "'a gterm"
   assume F: "\<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F>" and G: "groot t \<in> \<G>"
   obtain g ss where t[simp]: "t = GFun g ss" by (cases t, auto)
   then have "\<exists> qs. length qs = length ss \<and> (\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i)) \<and> qs ! i |\<in>| Q)"
     using contain ta_contains_aux_state_set[of \<F> Q \<A> "ss ! i" for i] F
     unfolding ta_contains_def \<T>\<^sub>G_funas_gterm_conv
     using Ex_list_of_length_P[of "length ss" "\<lambda> q i. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"]
     by auto (metis SUP_le_iff nth_mem)
   then obtain qs where " length qs = length ss"
     "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"
     "\<forall> i < length qs. qs ! i |\<in>| Q"
     by blast
   then obtain q where "q |\<in>| Q\<^sub>f" "q |\<in>| ta_der \<A> (term_of_gterm t)"
     using conjunct2[OF contain[unfolded ta_contains_def]] G
     by (auto simp: ta_contains_def ta_contains_aux_def fset_list_fsubset_eq_nth_conv) metis
   then show "t \<in> gta_lang Q\<^sub>f \<A>"
     by (intro gta_langI) simp
 qed
 
 lemma ta_contains: 
   assumes contain: "ta_contains \<F> \<F> \<A> Q Q\<^sub>f"
   shows "\<T>\<^sub>G \<F> \<subseteq> gta_lang Q\<^sub>f \<A>" (is "?A \<subseteq> _")
 proof -
   have [simp]: "funas_gterm t \<subseteq> \<F> \<Longrightarrow> groot t \<in> \<F>" for t by (cases t) auto
   have [simp]: "funas_gterm t \<subseteq> \<F> \<Longrightarrow> \<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F>" for t
     by (cases t) auto
   show ?thesis using ta_contains_both[OF contain]
     by (auto simp: \<T>\<^sub>G_equivalent_def)
 qed
 
 text \<open>Relabeling, map finite set to natural numbers\<close>
 
 
 lemma map_fset_to_nat_inj:
   assumes "Y |\<subseteq>| X"
   shows "finj_on (map_fset_to_nat X) Y"
 proof -
   { fix x y assume "x |\<in>| X" "y |\<in>| X"
     then have "x |\<in>| fset_of_list (sorted_list_of_fset X)" "y |\<in>| fset_of_list (sorted_list_of_fset X)"
       by simp_all
     note this[unfolded mem_idx_fset_sound]
     then have "x = y" if "map_fset_to_nat X x = map_fset_to_nat X y"
       using that nth_eq_iff_index_eq[OF distinct_sorted_list_of_fset[of X]]
       by (force dest: mem_idx_sound_output simp: map_fset_to_nat_def) }
   then show ?thesis using assms
     by (auto simp add: finj_on_def' fBall_def)
 qed
 
 lemma map_fset_fset_to_nat_inj:
   assumes "Y |\<subseteq>| X"
   shows "finj_on (map_fset_fset_to_nat X) Y" using assms
 proof -
   let ?f = "map_fset_fset_to_nat X"
   { fix x y assume "x |\<in>| X" "y |\<in>| X"
     then have "sorted_list_of_fset x |\<in>| fset_of_list (sorted_list_of_fset (sorted_list_of_fset |`| X))"
       "sorted_list_of_fset y |\<in>| fset_of_list (sorted_list_of_fset (sorted_list_of_fset |`| X))"
         unfolding map_fset_fset_to_nat_def by auto
     note this[unfolded mem_idx_fset_sound]
     then have "x = y" if "?f x = ?f y"
       using that nth_eq_iff_index_eq[OF distinct_sorted_list_of_fset[of "sorted_list_of_fset |`| X"]]
       by (auto simp: map_fset_fset_to_nat_def)
          (metis mem_idx_sound_output sorted_list_of_fset_simps(1))+}
   then show ?thesis using assms
     by (auto simp add: finj_on_def' fBall_def)
 qed
 
 
 lemma relabel_gta_lang [simp]:
   "gta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = gta_lang Q \<A>"
 proof -
   have "gta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>"
     unfolding relabel_ta_def relabel_Q\<^sub>f_def
     by (intro fmap_states_ta_lang2 map_fset_to_nat_inj) simp
   then show ?thesis by fastforce
 qed
 
 
 lemma \<L>_relable [simp]: "\<L> (relabel_reg R) = \<L> R"
   by (auto simp: \<L>_def relabel_reg_def)
 
 lemma relabel_ta_lang [simp]:
   "ta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = ta_lang Q \<A>"
   unfolding ta_lang_to_gta_lang
   using relabel_gta_lang
   by simp
 
 
 
 lemma relabel_fset_gta_lang [simp]:
   "gta_lang (relabel_fset_Q\<^sub>f Q \<A>) (relabel_fset_ta \<A>) = gta_lang Q \<A>"
 proof -
   have "gta_lang (relabel_fset_Q\<^sub>f Q \<A>) (relabel_fset_ta \<A>) = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>"
     unfolding relabel_fset_Q\<^sub>f_def relabel_fset_ta_def
     by (intro fmap_states_ta_lang2 map_fset_fset_to_nat_inj) simp
   then show ?thesis by fastforce
 qed
 
 
 lemma \<L>_relable_fset [simp]: "\<L> (relable_fset_reg R) = \<L> R"
   by (auto simp: \<L>_def relable_fset_reg_def)
 
 lemma ta_states_trim_ta:
   "\<Q> (trim_ta Q \<A>) |\<subseteq>| \<Q> \<A>"
   unfolding trim_ta_def using ta_prod_reach_states .
 
 lemma trim_ta_reach: "\<Q> (trim_ta Q \<A>) |\<subseteq>| ta_reachable (trim_ta Q \<A>)"
   unfolding trim_ta_def using ta_only_prod_reachable ta_only_reach_reachable
   by metis
 
 lemma trim_ta_prod: "\<Q> (trim_ta Q A) |\<subseteq>| ta_productive Q (trim_ta Q A)"
   unfolding trim_ta_def using ta_only_prod_productive
   by metis
 
 lemma empty_gta_lang:
   "gta_lang Q (TA {||} {||}) = {}"
   using ta_reachable_gtermI
   by (force simp: gta_lang_def gta_der_def elim!: ta_langE)
 
 abbreviation empty_reg where
   "empty_reg \<equiv> Reg {||} (TA {||} {||})"
 
 lemma \<L>_epmty:
   "\<L> empty_reg = {}"
   by (auto simp: \<L>_def empty_gta_lang)
 
 lemma const_ta_lang:
   "gta_lang {|q|} (TA  {| TA_rule f [] q |} {||}) = {GFun f []}"
 proof -
   have [dest!]: "q' |\<in>| ta_der (TA  {| TA_rule f [] q |} {||}) t' \<Longrightarrow> ground t' \<Longrightarrow> t' = Fun f []" for t' q'
     by (induct t') auto
   show ?thesis
     by (auto simp: gta_lang_def gta_der_def elim!: gta_langE)
        (metis gterm_of_term.simps list.simps(8) term_of_gterm_inv)
 qed
 
 
 lemma run_argsD:
   "run \<A> s t \<Longrightarrow> length (gargs s) = length (gargs t) \<and> (\<forall> i < length (gargs t). run \<A> (gargs s ! i) (gargs t ! i))"
   using run.cases by fastforce
 
 lemma run_root_rule:
   "run \<A> s t \<Longrightarrow> TA_rule (groot_sym t) (map ex_comp_state (gargs s)) (ex_rule_state s) |\<in>| (rules \<A>) \<and>
      (ex_rule_state s = ex_comp_state s \<or> (ex_rule_state s, ex_comp_state s) |\<in>| (eps \<A>)|\<^sup>+|)"
   by (cases s; cases t) (auto elim: run.cases)
 
 lemma run_poss_eq: "run \<A> s t \<Longrightarrow> gposs s = gposs t"
   by (induct rule: run.induct) auto
 
 lemma run_gsubt_cl:
   assumes "run \<A> s t" and "p \<in> gposs t"
   shows "run \<A> (gsubt_at s p) (gsubt_at t p)" using assms
 proof (induct p arbitrary: s t)
   case (Cons i p) show ?case using Cons(1) Cons(2-)
     by (cases s; cases t) (auto dest: run_argsD)
 qed auto
 
 lemma run_replace_at:
   assumes "run \<A> s t" and "run \<A> u v" and "p \<in> gposs s"
     and "ex_comp_state (gsubt_at s p) = ex_comp_state u"
   shows "run \<A> s[p \<leftarrow> u]\<^sub>G t[p \<leftarrow> v]\<^sub>G" using assms
 proof (induct p arbitrary: s t)
   case (Cons i p)
   obtain r q qs f ts where [simp]: "s = GFun (r, q) qs" "t = GFun f ts" by (cases s, cases t) auto
   have *: "j < length qs \<Longrightarrow> ex_comp_state (qs[i := (qs ! i)[p \<leftarrow> u]\<^sub>G] ! j) = ex_comp_state (qs ! j)" for j
     using Cons(5) by (cases "i = j", cases p) auto
   have [simp]: "map ex_comp_state (qs[i := (qs ! i)[p \<leftarrow> u]\<^sub>G]) = map ex_comp_state qs" using Cons(5)
     by (auto simp: *[unfolded comp_def] intro!: nth_equalityI)
   have "run \<A> (qs ! i)[p \<leftarrow> u]\<^sub>G (ts ! i)[p \<leftarrow> v]\<^sub>G" using Cons(2-)
     by (intro Cons(1)) (auto dest: run_argsD)
   moreover have "i < length qs" "i < length ts" using Cons(4) run_poss_eq[OF Cons(2)]
     by force+
   ultimately show ?case using Cons(2) run_root_rule[OF Cons(2)]
     by (fastforce simp: nth_list_update dest: run_argsD intro!: run.intros)
 qed simp
 
 text \<open>relating runs to derivation definition\<close>
 
 lemma run_to_comp_st_gta_der:
   "run \<A> s t \<Longrightarrow> ex_comp_state s |\<in>| gta_der \<A> t"
 proof (induct s arbitrary: t)
   case (GFun q qs)
   show ?case using GFun(1)[OF nth_mem, of i "gargs t ! i" for i]
     using run_argsD[OF GFun(2)] run_root_rule[OF GFun(2-)]
     by (cases t) (auto simp: gta_der_def intro!: exI[of _ "map ex_comp_state qs"] exI[of _ "fst q"])
 qed
 
 lemma run_to_rule_st_gta_der:
   assumes "run \<A> s t" shows "ex_rule_state s |\<in>| gta_der \<A> t"
 proof (cases s)
   case [simp]: (GFun q qs)
   have "i < length qs \<Longrightarrow> ex_comp_state (qs ! i) |\<in>| gta_der \<A> (gargs t ! i)" for i
     using run_to_comp_st_gta_der[of \<A>] run_argsD[OF assms] by force
   then show ?thesis using conjunct1[OF run_argsD[OF assms]] run_root_rule[OF assms]
     by (cases t) (auto simp: gta_der_def intro!: exI[of _ "map ex_comp_state qs"] exI[of _ "fst q"])
 qed
 
 lemma run_to_gta_der_gsubt_at:
   assumes "run \<A> s t" and "p \<in> gposs t"
   shows "ex_rule_state (gsubt_at s p) |\<in>| gta_der \<A> (gsubt_at t p)"
     "ex_comp_state (gsubt_at s p) |\<in>| gta_der \<A> (gsubt_at t p)"
   using assms run_gsubt_cl[THEN run_to_comp_st_gta_der] run_gsubt_cl[THEN run_to_rule_st_gta_der]
   by blast+
 
 lemma gta_der_to_run:
   "q |\<in>| gta_der \<A> t \<Longrightarrow> (\<exists> p qs. run \<A> (GFun (p, q) qs) t)" unfolding gta_der_def
 proof (induct rule: ta_der_gterm_induct)
   case (GFun f ts ps p q)
   from GFun(5) Ex_list_of_length_P[of "length ts" "\<lambda> qs i. run \<A> (GFun (fst qs, ps ! i) (snd qs)) (ts ! i)"]
   obtain qss where mid: "length qss = length ts" "\<forall> i < length ts .run \<A> (GFun (fst (qss ! i), ps ! i) (snd (qss ! i))) (ts ! i)"
     by auto
   have [simp]: "map (ex_comp_state \<circ> (\<lambda>(qs, y). GFun (fst y, qs) (snd y))) (zip ps qss) = ps" using GFun(2) mid(1)
     by (intro nth_equalityI) auto
   show ?case using mid GFun(1 - 4)
     by (intro exI[of _ p] exI[of _ "map2 (\<lambda> f args. GFun (fst args, f) (snd args)) ps qss"])
        (auto intro: run.intros)
 qed
 
 lemma run_ta_der_ctxt_split1:
   assumes "run \<A> s t" "p \<in> gposs t"
   shows "ex_comp_state s |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm t) p)\<langle>Var (ex_comp_state (gsubt_at s p))\<rangle>"
   using assms
 proof (induct p arbitrary: s t)
   case (Cons i p)
   obtain q f qs ts where [simp]: "s = GFun q qs" "t = GFun f ts" and l: "length qs = length ts"
     using run_argsD[OF Cons(2)] by (cases s, cases t) auto
   from Cons(2, 3) l have "ex_comp_state (qs ! i) |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm (ts ! i)) p)\<langle>Var (ex_comp_state (gsubt_at (qs ! i) p))\<rangle>"
     by (intro Cons(1)) (auto dest: run_argsD)
   then show ?case using Cons(2-) l
     by (fastforce simp: nth_append_Cons min_def dest: run_root_rule run_argsD
     intro!: exI[of _ "map ex_comp_state (gargs s)"]  exI[of _ "ex_rule_state s"]
             run_to_comp_st_gta_der[of \<A> "qs ! i" "ts ! i" for i, unfolded comp_def gta_der_def])
 qed auto
 
 
 lemma run_ta_der_ctxt_split2:
   assumes "run \<A> s t" "p \<in> gposs t"
   shows "ex_comp_state s |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm t) p)\<langle>Var (ex_rule_state (gsubt_at s p))\<rangle>"
 proof (cases "ex_rule_state (gsubt_at s p) = ex_comp_state (gsubt_at s p)")
   case False then show ?thesis
     using run_root_rule[OF run_gsubt_cl[OF assms]]
     by (intro ta_der_eps_ctxt[OF run_ta_der_ctxt_split1[OF assms]]) auto
 qed (auto simp: run_ta_der_ctxt_split1[OF assms, unfolded comp_def])
 
 end
\ No newline at end of file
diff --git a/thys/Ribbon_Proofs/More_Finite_Map.thy b/thys/Ribbon_Proofs/More_Finite_Map.thy
--- a/thys/Ribbon_Proofs/More_Finite_Map.thy
+++ b/thys/Ribbon_Proofs/More_Finite_Map.thy
@@ -1,106 +1,109 @@
 section \<open>Finite partial functions\<close>
 
 theory More_Finite_Map imports
   "HOL-Library.Finite_Map"
 begin
 
+lemma fdisjoint_iff: "A |\<inter>| B = {||} \<longleftrightarrow> (\<forall>x. x |\<in>| A \<longrightarrow> x |\<notin>| B)"
+  by (smt (verit) disjoint_iff_fnot_equal)
+
 unbundle lifting_syntax
 unbundle fmap.lifting
 
 type_notation fmap (infix "\<rightharpoonup>\<^sub>f" 9)
 
 
 subsection \<open>Difference\<close>
 
 definition
   map_diff :: "('k \<rightharpoonup> 'v) \<Rightarrow> 'k fset \<Rightarrow> ('k \<rightharpoonup> 'v)"
 where
   "map_diff f ks = restrict_map f (- fset ks)"
 
 lift_definition
   fmap_diff :: "('k \<rightharpoonup>\<^sub>f 'v) \<Rightarrow> 'k fset \<Rightarrow> ('k \<rightharpoonup>\<^sub>f 'v)" (infix "\<ominus>" 110)
 is "map_diff"
 by (auto simp add: map_diff_def)
 
 subsection \<open>Comprehension\<close>
 
 definition
   make_map :: "'k fset \<Rightarrow> 'v \<Rightarrow> ('k \<rightharpoonup> 'v)"
 where
   "make_map ks v \<equiv> \<lambda>k. if k \<in> fset ks then Some v else None"
 
 lemma make_map_transfer[transfer_rule]: "(rel_fset (=) ===> A ===> rel_map A) make_map make_map"
 unfolding make_map_def
 by transfer_prover
 
 lemma dom_make_map:
   "dom (make_map ks v) = fset ks"
 by (metis domIff make_map_def not_Some_eq set_eqI)
 
 lift_definition
   make_fmap :: "'k fset \<Rightarrow> 'v \<Rightarrow> ('k \<rightharpoonup>\<^sub>f 'v)" ("[ _ |=> _ ]")
 is "make_map" parametric make_map_transfer
 by (unfold make_map_def dom_def, auto)
 
 lemma make_fmap_empty[simp]: "[ {||} |=> f ] = fmempty"
 by transfer (simp add: make_map_def)
 
 
 
 subsection \<open>Domain\<close>
 
 
 lemma fmap_add_commute:
   assumes "fmdom A |\<inter>| fmdom B = {||}"
   shows "A ++\<^sub>f B = B ++\<^sub>f A"
 using assms including fset.lifting
 apply (transfer)
 apply (rule ext)
 apply (auto simp: dom_def map_add_def split: option.splits)
 done
 
 lemma make_fmap_union:
   "[ xs |=> v ] ++\<^sub>f [ ys |=> v] = [ xs |\<union>| ys |=> v ]"
 by (transfer, auto simp add: make_map_def map_add_def)
 
 lemma fdom_make_fmap: "fmdom [ ks |=> v ] = ks"
 (* FIXME proper transfer proof *)
 apply (subst fmdom_def)
 apply transfer
 apply (auto simp: dom_def make_map_def fset_inverse)
 done
 
 subsection \<open>Lookup\<close>
 
 lift_definition
   lookup :: "('k \<rightharpoonup>\<^sub>f 'v) \<Rightarrow> 'k \<Rightarrow> 'v"
 is "(\<circ>) the" .
 
 lemma lookup_make_fmap:
   assumes "k \<in> fset ks"
   shows "lookup [ ks |=> v ] k = v"
 using assms by (transfer, simp add: make_map_def)
 
 lemma lookup_make_fmap1:
   "lookup [ {|k|} |=> v ] k = v"
 by (metis finsert.rep_eq insert_iff lookup_make_fmap)
 
 lemma lookup_union1:
   assumes "k |\<in>| fmdom ys"
   shows "lookup (xs ++\<^sub>f ys) k = lookup ys k"
 using assms including fset.lifting
 by transfer auto
 
 lemma lookup_union2:
   assumes "k |\<notin>| fmdom ys"
   shows "lookup (xs ++\<^sub>f ys) k = lookup xs k"
 using assms including fset.lifting
 by transfer (auto simp: map_add_def split: option.splits)
 
 lemma lookup_union3:
   assumes "k |\<notin>| fmdom xs"
   shows "lookup (xs ++\<^sub>f ys) k = lookup ys k"
 using assms including fset.lifting
 by transfer (auto simp: map_add_def split: option.splits)
 
 end
diff --git a/thys/Ribbon_Proofs/Ribbons_Graphical_Soundness.thy b/thys/Ribbon_Proofs/Ribbons_Graphical_Soundness.thy
--- a/thys/Ribbon_Proofs/Ribbons_Graphical_Soundness.thy
+++ b/thys/Ribbon_Proofs/Ribbons_Graphical_Soundness.thy
@@ -1,1125 +1,1133 @@
 section \<open>Soundness for graphical diagrams\<close>
 
 theory Ribbons_Graphical_Soundness imports
   Ribbons_Graphical
   More_Finite_Map
 begin
 
 text \<open>We prove that the proof rules for graphical ribbon proofs are sound
   with respect to the rules of separation logic.
 
   We impose an additional assumption to achieve soundness: that the
   Frame rule has no side-condition. This assumption is reasonable because there
   are several separation logics that lack such a side-condition, such as
   ``variables-as-resource''.
 
   We first describe how to extract proofchains from a diagram. This process is
   similar to the process of extracting commands from a diagram, which was
   described in @{theory Ribbon_Proofs.Ribbons_Graphical}. When we extract a proofchain, we
   don't just include the commands, but the assertions in between them. Our
   main lemma for proving soundness says that each of these proofchains
   corresponds to a valid separation logic proof.
 \<close>
 
 subsection \<open>Proofstate chains\<close>
 
 text \<open>When extracting a proofchain from a diagram, we need to keep track
   of which nodes we have processed and which ones we haven't. A
   proofstate, defined below, maps a node to ``Top'' if it hasn't been
   processed and ``Bot'' if it has.\<close>
 
 datatype topbot = Top | Bot
 
 type_synonym proofstate = "node \<rightharpoonup>\<^sub>f topbot"
 
 text \<open>A proofstate chain contains all the nodes and edges of a graphical
   diagram, interspersed with proofstates that track which nodes have been
   processed at each point.\<close>
 
 type_synonym ps_chain = "(proofstate, node + edge) chain"
 
 text \<open>The @{term "next_ps \<sigma>"} function processes one node or one edge in a
   diagram, given the current proofstate @{term \<sigma>}. It processes a node
   @{term v} by replacing the mapping from @{term v} to @{term Top} with a
   mapping from @{term v} to @{term Bot}. It processes an edge @{term e}
   (whose source and target nodes are @{term vs} and @{term ws} respectively)
   by removing all the mappings from @{term vs} to @{term Bot}, and adding
   mappings from @{term ws} to @{term Top}.\<close>
 
 fun next_ps :: "proofstate \<Rightarrow> node + edge \<Rightarrow> proofstate"
 where
   "next_ps \<sigma> (Inl v) = \<sigma> \<ominus> {|v|} ++\<^sub>f [{|v|} |=> Bot]"
 | "next_ps \<sigma> (Inr e) = \<sigma> \<ominus> fst3 e ++\<^sub>f [thd3 e |=> Top]"
 
 text \<open>The function @{term "mk_ps_chain \<Pi> \<pi>"} generates from @{term \<pi>}, which
   is a list of nodes and edges, a proofstate chain, by interspersing the
   elements of @{term \<pi>} with the appropriate proofstates. The first argument
   @{term \<Pi>} is the part of the chain that has already been converted.\<close>
 
 definition
   mk_ps_chain :: "[ps_chain, (node + edge) list] \<Rightarrow> ps_chain"
 where
   "mk_ps_chain \<equiv> foldl (\<lambda>\<Pi> x. cSnoc \<Pi> x (next_ps (post \<Pi>) x))"
 
 lemma mk_ps_chain_preserves_length:
   fixes \<pi> \<Pi>
   shows "chainlen (mk_ps_chain \<Pi> \<pi>) = chainlen \<Pi> + length \<pi>"
 proof (induct \<pi> arbitrary: \<Pi>)
   case Nil
   show ?case by (unfold mk_ps_chain_def, auto)
 next
   case (Cons x \<pi>)
   show ?case
   apply (unfold mk_ps_chain_def list.size foldl.simps)
   apply (fold mk_ps_chain_def)
   apply (auto simp add: Cons len_snoc)
   done
 qed
 
 text \<open>Distributing @{term mk_ps_chain} over @{term Cons}.\<close>
 lemma mk_ps_chain_cons:
   "mk_ps_chain \<Pi> (x # \<pi>) = mk_ps_chain (cSnoc \<Pi> x (next_ps (post \<Pi>) x)) \<pi>"
 by (auto simp add: mk_ps_chain_def)
 
 text \<open>Distributing @{term mk_ps_chain} over @{term snoc}.\<close>
 lemma mk_ps_chain_snoc:
   "mk_ps_chain \<Pi> (\<pi> @ [x])
     = cSnoc (mk_ps_chain \<Pi> \<pi>) x (next_ps (post (mk_ps_chain \<Pi> \<pi>)) x)"
 by (unfold mk_ps_chain_def, auto)
 
 text \<open>Distributing @{term mk_ps_chain} over @{term cCons}.\<close>
 lemma mk_ps_chain_ccons:
   fixes \<pi> \<Pi>
   shows "mk_ps_chain (\<lbrace> \<sigma> \<rbrace> \<cdot> x \<cdot> \<Pi>) \<pi> = \<lbrace> \<sigma> \<rbrace> \<cdot> x \<cdot> mk_ps_chain \<Pi> \<pi> "
 by (induct \<pi> arbitrary: \<Pi>, auto simp add: mk_ps_chain_cons mk_ps_chain_def)
 
 lemma pre_mk_ps_chain:
   fixes \<Pi> \<pi>
   shows "pre (mk_ps_chain \<Pi> \<pi>) = pre \<Pi>"
 apply (induct \<pi> arbitrary: \<Pi>)
 apply (auto simp add: mk_ps_chain_def mk_ps_chain_cons pre_snoc)
 done
 
 text \<open>A chain which is obtained from the list @{term \<pi>}, has @{term \<pi>}
   as its list of commands. The following lemma states this in a slightly
   more general form, that allows for part of the chain to have already
   been processed.\<close>
 
 lemma comlist_mk_ps_chain:
   "comlist (mk_ps_chain \<Pi> \<pi>) = comlist \<Pi> @ \<pi>"
 proof (induct \<pi> arbitrary: \<Pi>)
   case Nil
   thus ?case by (auto simp add: mk_ps_chain_def)
 next
   case (Cons x \<pi>')
   show ?case
   apply (unfold mk_ps_chain_def foldl.simps, fold mk_ps_chain_def)
   apply (auto simp add: Cons comlist_snoc)
   done
 qed
 
 text \<open>In order to perform induction over our diagrams, we shall wish
   to obtain ``smaller'' diagrams, by removing nodes or edges. However, the
   syntax and well-formedness constraints for diagrams are such that although
   we can always remove an edge from a diagram, we cannot (in general) remove
   a node -- the resultant diagram would not be a well-formed if an edge
   connected to that node.
 
   Hence, we consider ``partially-processed diagrams'' @{term "(G,S)"}, which
   comprise a diagram @{term G} and a set @{term S} of nodes. @{term S} denotes
   the subset of @{term G}'s initial nodes that have already been processed,
   and can be thought of as having been removed from @{term G}.
 
   We now give an updated version of the @{term "lins G"} function. This was
   originally defined in @{theory Ribbon_Proofs.Ribbons_Graphical}. We provide an extra
   parameter, @{term S}, which denotes the subset of @{term G}'s initial nodes
   that shouldn't be included in the linear extensions.\<close>
 
 definition lins2 :: "[node fset, diagram] \<Rightarrow> lin set"
 where
   "lins2 S G \<equiv> {\<pi> :: lin .
     (distinct \<pi>)
   \<and> (set \<pi> = (fset G^V - fset S) <+> set G^E)
   \<and> (\<forall>i j v e. i < length \<pi> \<and> j < length \<pi>
     \<and> \<pi>!i = Inl v \<and> \<pi>!j = Inr e \<and> v |\<in>| fst3 e \<longrightarrow> i<j)
   \<and> (\<forall>j k w e. j < length \<pi> \<and> k < length \<pi>
     \<and> \<pi>!j = Inr e \<and> \<pi>!k = Inl w \<and> w |\<in>| thd3 e \<longrightarrow> j<k) }"
 
 lemma lins2D:
   assumes "\<pi> \<in> lins2 S G"
   shows "distinct \<pi>"
     and "set \<pi> = (fset G^V - fset S) <+> set G^E"
     and "\<And>i j v e. \<lbrakk> i < length \<pi> ; j < length \<pi> ;
       \<pi>!i = Inl v ; \<pi>!j = Inr e ; v |\<in>| fst3 e \<rbrakk> \<Longrightarrow> i<j"
     and "\<And>i k w e. \<lbrakk> j < length \<pi> ; k < length \<pi> ;
       \<pi>!j = Inr e ; \<pi>!k = Inl w ; w |\<in>| thd3 e \<rbrakk> \<Longrightarrow> j<k"
 using assms
 apply (unfold lins2_def Collect_iff)
 apply (elim conjE, assumption)+
 apply blast+
 done
 
 lemma lins2I:
   assumes "distinct \<pi>"
     and "set \<pi> = (fset G^V - fset S) <+> set G^E"
     and "\<And>i j v e. \<lbrakk> i < length \<pi> ; j < length \<pi> ;
       \<pi>!i = Inl v ; \<pi>!j = Inr e ; v |\<in>| fst3 e \<rbrakk> \<Longrightarrow> i<j"
     and "\<And>j k w e. \<lbrakk> j < length \<pi> ; k < length \<pi> ;
       \<pi>!j = Inr e ; \<pi>!k = Inl w ; w |\<in>| thd3 e \<rbrakk> \<Longrightarrow> j<k"
   shows "\<pi> \<in> lins2 S G"
 using assms
 apply (unfold lins2_def Collect_iff, intro conjI)
 apply assumption+
 apply blast+
 done
 
 text \<open>When @{term S} is empty, the two definitions coincide.\<close>
 lemma lins_is_lins2_with_empty_S:
   "lins G = lins2 {||} G"
 by (unfold lins_def lins2_def, auto)
 
 text \<open>The first proofstate for a diagram @{term G} is obtained by
   mapping each of its initial nodes to @{term Top}.\<close>
 definition
   initial_ps :: "diagram \<Rightarrow> proofstate"
 where
   "initial_ps G \<equiv> [ initials G |=> Top ]"
 
 text \<open>The first proofstate for the partially-processed diagram @{term G} is
   obtained by mapping each of its initial nodes to @{term Top}, except those
   in @{term S}, which are mapped to @{term Bot}.\<close>
 definition
   initial_ps2 :: "[node fset, diagram] \<Rightarrow> proofstate"
 where
   "initial_ps2 S G \<equiv> [ initials G - S |=> Top ] ++\<^sub>f [ S |=> Bot ]"
 
 text \<open>When @{term S} is empty, the above two definitions coincide.\<close>
 lemma initial_ps_is_initial_ps2_with_empty_S:
   "initial_ps = initial_ps2 {||}"
 apply (unfold fun_eq_iff, intro allI)
 apply (unfold initial_ps_def initial_ps2_def)
 apply simp
 done
 
 text \<open>The following function extracts the set of proofstate chains from
    a diagram.\<close>
 definition
   ps_chains :: "diagram \<Rightarrow> ps_chain set"
 where
   "ps_chains G \<equiv> mk_ps_chain (cNil (initial_ps G)) ` lins G"
 
 text \<open>The following function extracts the set of proofstate chains from
    a partially-processed diagram. Nodes in @{term S} are excluded from
    the resulting chains.\<close>
 definition
   ps_chains2 :: "[node fset, diagram] \<Rightarrow> ps_chain set"
 where
   "ps_chains2 S G \<equiv> mk_ps_chain (cNil (initial_ps2 S G)) ` lins2 S G"
 
 text \<open>When @{term S} is empty, the above two definitions coincide.\<close>
 lemma ps_chains_is_ps_chains2_with_empty_S:
   "ps_chains = ps_chains2 {||}"
 apply (unfold fun_eq_iff, intro allI)
 apply (unfold ps_chains_def ps_chains2_def)
 apply (fold initial_ps_is_initial_ps2_with_empty_S)
 apply (fold lins_is_lins2_with_empty_S)
 apply auto
 done
 
 text \<open>We now wish to describe proofstates chain that are well-formed. First,
   let us say that @{term "f ++\<^sub>fdisjoint g"} is defined, when @{term f} and
   @{term g} have disjoint domains, as @{term "f ++\<^sub>f g"}. Then, a well-formed
   proofstate chain consists of triples of the form @{term "(\<sigma> ++\<^sub>fdisjoint
   [{| v |} |=> Top], Inl v, \<sigma> ++\<^sub>fdisjoint [{| v |} |=> Bot])"}, where @{term v}
   is a node, or of the form @{term "(\<sigma> ++\<^sub>fdisjoint [{| vs |} |=> Bot], Inr e,
   \<sigma> ++\<^sub>fdisjoint [{| ws |} |=> Top])"}, where @{term e} is an edge with source
   and target nodes @{term vs} and @{term ws} respectively.
 
   The definition below describes a well-formed triple; we then lift this
   to complete chains shortly.\<close>
 
 definition
   wf_ps_triple :: "proofstate \<times> (node + edge) \<times> proofstate \<Rightarrow> bool"
 where
   "wf_ps_triple T = (case snd3 T of
     Inl v \<Rightarrow> (\<exists>\<sigma>. v |\<notin>| fmdom \<sigma>
       \<and> fst3 T = [ {|v|} |=> Top ] ++\<^sub>f \<sigma>
       \<and> thd3 T = [ {|v|} |=> Bot ] ++\<^sub>f \<sigma>)
   | Inr e \<Rightarrow> (\<exists>\<sigma>. (fst3 e |\<union>| thd3 e) |\<inter>| fmdom \<sigma> = {||}
       \<and> fst3 T = [ fst3 e |=> Bot ] ++\<^sub>f \<sigma>
       \<and> thd3 T = [ thd3 e |=> Top ] ++\<^sub>f \<sigma>))"
 
 lemma wf_ps_triple_nodeI:
   assumes "\<exists>\<sigma>. v |\<notin>| fmdom \<sigma>  \<and>
     \<sigma>1 = [ {|v|} |=> Top ] ++\<^sub>f \<sigma> \<and>
     \<sigma>2 = [ {|v|} |=> Bot ] ++\<^sub>f \<sigma>"
   shows "wf_ps_triple (\<sigma>1, Inl v, \<sigma>2)"
 using assms unfolding wf_ps_triple_def
 by (auto simp add: fst3_simp snd3_simp thd3_simp)
 
 lemma wf_ps_triple_edgeI:
   assumes "\<exists>\<sigma>. (fst3 e |\<union>| thd3 e) |\<inter>| fmdom \<sigma> = {||}
       \<and> \<sigma>1 = [ fst3 e |=> Bot ] ++\<^sub>f \<sigma>
       \<and> \<sigma>2 = [ thd3 e |=> Top ] ++\<^sub>f \<sigma>"
   shows "wf_ps_triple (\<sigma>1, Inr e, \<sigma>2)"
 using assms unfolding wf_ps_triple_def
 by (auto simp add: fst3_simp snd3_simp thd3_simp)
 
 definition
   wf_ps_chain :: "ps_chain \<Rightarrow> bool"
 where
   "wf_ps_chain \<equiv> chain_all wf_ps_triple"
 
 lemma next_initial_ps2_vertex:
   "initial_ps2 ({|v|} |\<union>| S) G
   = initial_ps2 S G \<ominus> {|v|} ++\<^sub>f [ {|v|} |=> Bot ]"
 apply (unfold initial_ps2_def)
 apply transfer
 apply (auto simp add: make_map_def map_diff_def map_add_def restrict_map_def)
 done
 
 lemma next_initial_ps2_edge:
   assumes "G = Graph V \<Lambda> E" and "G' = Graph V' \<Lambda> E'" and
     "V' = V - fst3 e" and "E' = removeAll e E" and "e \<in> set E" and
     "fst3 e |\<subseteq>| S" and "S |\<subseteq>| initials G" and "wf_dia G"
   shows "initial_ps2 (S - fst3 e) G' =
   initial_ps2 S G \<ominus> fst3 e ++\<^sub>f [ thd3 e |=> Top ]"
 proof (insert assms, unfold initial_ps2_def, transfer)
   fix G V \<Lambda> E G' V' E' e S
   assume G_def: "G = Graph V \<Lambda> E" and G'_def: "G' = Graph V' \<Lambda> E'" and
     V'_def: "V' = V - fst3 e" and E'_def: "E' = removeAll e E" and
     e_in_E: "e \<in> set E" and fst_e_in_S: "fst3 e |\<subseteq>| S" and
     S_initials: "S |\<subseteq>| initials G" and wf_G: "wf_dia G"
   have "thd3 e |\<inter>| initials G = {||}"
     by (auto simp add: initials_def G_def e_in_E)
   show "make_map (initials G' - (S - fst3 e)) Top ++ make_map (S - fst3 e) Bot
     = map_diff (make_map (initials G - S) Top ++ make_map S Bot) (fst3 e)
         ++ make_map (thd3 e) Top"
   apply (unfold make_map_def map_diff_def)
   apply (unfold map_add_def restrict_map_def)
   apply (unfold minus_fset)
   apply (unfold fun_eq_iff initials_def)
   apply (unfold G_def G'_def V'_def E'_def)
   apply (unfold edges.simps vertices.simps)
   apply (simp add: less_eq_fset.rep_eq e_in_E)
   apply safe
   apply (insert \<open>thd3 e |\<inter>| initials G = {||}\<close>)[1]
   apply (insert S_initials, fold fset_cong)[2]
   apply (unfold less_eq_fset.rep_eq initials_def filter_fset)
   apply (auto simp add: G_def e_in_E)[1]
   apply (auto simp add: G_def e_in_E)[1]
   apply (auto simp add: G_def e_in_E)[1]
   apply (insert wf_G)[1]
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(3))
   apply (unfold acyclicity_def)
   apply (metis fst_e_in_S inter_fset le_iff_inf subsetD)
   apply (insert wf_G)[1]
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(4))
   apply (drule linearityD2)
   apply (fold fset_cong, unfold inter_fset fset_simps)
   apply (insert e_in_E, blast)[1]
   apply (insert wf_G)[1]
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(3))
   apply (metis (lifting) e_in_E G_def empty_iff fset_simps(1)
     finter_iff linearityD(2) wf_G wf_dia_inv(4))
   apply (insert wf_G)[1]
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(4))
   apply (drule linearityD2)
   apply (fold fset_cong, unfold inter_fset fset_simps)
   apply (insert e_in_E, blast)[1]
   apply (insert wf_G)[1]
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(3))
   apply (metis (lifting) e_in_E G_def empty_iff fset_simps(1)
     finter_iff linearityD(2) wf_G wf_dia_inv(4))
   apply (insert wf_G)
   apply (unfold G_def vertices.simps edges.simps)
   apply (drule wf_dia_inv(5))
   apply (unfold less_eq_fset.rep_eq union_fset)
   apply auto[1]
   apply (drule wf_dia_inv(5))
   apply (unfold less_eq_fset.rep_eq union_fset)
   apply auto[1]
   apply (drule wf_dia_inv(5))
   apply (unfold less_eq_fset.rep_eq union_fset)
   apply (auto simp add: e_in_E)[1]
   apply (drule wf_dia_inv(5))
   apply (unfold less_eq_fset.rep_eq union_fset)
   apply (auto simp add: e_in_E)[1]
   done
 qed
 
 lemma next_lins2_vertex:
   assumes "Inl v # \<pi> \<in> lins2 S G"
   assumes "v |\<notin>| S"
   shows "\<pi> \<in> lins2 ({|v|} |\<union>| S) G"
 proof -
   note lins2D = lins2D[OF assms(1)]
   show ?thesis
   proof (intro lins2I)
     show "distinct \<pi>" using lins2D(1) by auto
   next
     have "set \<pi> = set (Inl v # \<pi>) - {Inl v}" using lins2D(1) by auto
     also have "... = (fset G^V - fset ({|v|} |\<union>| S)) <+> set G^E"
       using lins2D(2) by auto
     finally show "set \<pi> = (fset G^V - fset ({|v|} |\<union>| S)) <+> set G^E"
       by auto
   next
     fix i j v e
     assume "i < length \<pi>" "j < length \<pi>" "\<pi> ! i = Inl v"
       "\<pi> ! j = Inr e" "v |\<in>| fst3 e"
     thus "i < j" using lins2D(3)[of "i+1" "j+1"] by auto
   next
     fix j k w e
     assume "j < length \<pi>" "k < length \<pi>" "\<pi> ! j = Inr e"
       "\<pi> ! k = Inl w" "w |\<in>| thd3 e"
     thus "j < k" using lins2D(4)[of "j+1" "k+1"] by auto
   qed
 qed
 
 lemma next_lins2_edge:
   assumes "Inr e # \<pi> \<in> lins2 S (Graph V \<Lambda> E)"
       and "vs |\<subseteq>| S"
       and "e = (vs,c,ws)"
   shows "\<pi> \<in> lins2 (S - vs) (Graph (V - vs) \<Lambda> (removeAll e E))"
 proof -
   note lins2D = lins2D[OF assms(1)]
   show ?thesis
   proof (intro lins2I, unfold vertices.simps edges.simps)
     show "distinct \<pi>"
     using lins2D(1) by auto
   next
     show "set \<pi> = (fset (V - vs) - fset (S - vs))
       <+> set (removeAll e E)"
     apply (insert lins2D(1) lins2D(2) assms(2))
     apply (unfold assms(3) vertices.simps edges.simps less_eq_fset.rep_eq, simp)
     apply (unfold diff_diff_eq)
     proof -
       have "\<forall>a aa b.
        insert (Inr (vs, c, ws)) (set \<pi>) = (fset V - fset S) <+> set E \<longrightarrow>
        fset vs \<subseteq> fset S \<longrightarrow>
        Inr (vs, c, ws) \<notin> set \<pi> \<longrightarrow>
        distinct \<pi> \<longrightarrow> (a, aa, b) \<in> set E \<longrightarrow> Inr (a, aa, b) \<notin> set \<pi> \<longrightarrow> b = ws"
      by (metis (lifting) InrI List.set_simps(2)
       prod.inject set_ConsD sum.simps(2))
 
      moreover have "\<forall>a aa b.
        insert (Inr (vs, c, ws)) (set \<pi>) = (fset V - fset S) <+> set E \<longrightarrow>
        fset vs \<subseteq> fset S \<longrightarrow>
        Inr (vs, c, ws) \<notin> set \<pi> \<longrightarrow>
        distinct \<pi> \<longrightarrow> (a, aa, b) \<in> set E \<longrightarrow> Inr (a, aa, b) \<notin> set \<pi> \<longrightarrow> aa = c"
      by (metis (lifting) InrI List.set_simps(2)
       prod.inject set_ConsD sum.simps(2))
 
      moreover have "\<forall>x. insert (Inr (vs, c, ws)) (set \<pi>) = (fset V - fset S) <+> set E \<longrightarrow>
          fset vs \<subseteq> fset S \<longrightarrow>
          Inr (vs, c, ws) \<notin> set \<pi> \<longrightarrow>
          distinct \<pi> \<longrightarrow> x \<in> set \<pi> \<longrightarrow> x \<in> (fset V - fset S) <+> set E - {(vs, c, ws)}"
       apply (unfold insert_is_Un[of _ "set \<pi>"])
       apply (fold assms(3))
       apply clarify
       apply (subgoal_tac "set \<pi> = ((fset V - fset S) <+> set E) - {Inr e}")
       by auto
     ultimately show "Inr (vs, c, ws) \<notin> set \<pi> \<and> distinct \<pi> \<Longrightarrow>
       insert (Inr (vs, c, ws)) (set \<pi>) = (fset V - fset S) <+> set E \<Longrightarrow>
       fset vs \<subseteq> fset S \<Longrightarrow> set \<pi> = (fset V - fset S) <+> set E - {(vs, c, ws)}"
     by blast
     qed
   next
     fix i j v e
     assume "i < length \<pi>" "j < length \<pi>" "\<pi> ! i = Inl v"
       "\<pi> ! j = Inr e" "v |\<in>| fst3 e"
     thus "i < j" using lins2D(3)[of "i+1" "j+1"] by auto
   next
     fix j k w e
     assume "j < length \<pi>" "k < length \<pi>" "\<pi> ! j = Inr e"
       "\<pi> ! k = Inl w" "w |\<in>| thd3 e"
     thus "j < k" using lins2D(4)[of "j+1" "k+1"] by auto
   qed
 qed
 
 
 text \<open>We wish to prove that every proofstate chain that can be obtained from
   a linear extension of @{term G} is well-formed and has as its final
   proofstate that state in which every terminal node in @{term G} is mapped
   to @{term Bot}.
 
   We first prove this for partially-processed diagrams, for
   then the result for ordinary diagrams follows as an easy corollary.
 
   We use induction on the size of the partially-processed diagram. The size of
   a partially-processed diagram @{term "(G,S)"} is defined as the number of
   nodes in @{term G}, plus the number of edges, minus the number of nodes in
   @{term S}.\<close>
 
 lemma wf_chains2:
   fixes k
   assumes "S |\<subseteq>| initials G"
       and "wf_dia G"
       and "\<Pi> \<in> ps_chains2 S G"
       and "fcard G^V + length G^E = k + fcard S"
   shows "wf_ps_chain \<Pi> \<and> (post \<Pi> = [ terminals G |=> Bot ])"
 using assms
 proof (induct k arbitrary: S G \<Pi>)
   case 0
   obtain V \<Lambda> E where G_def: "G = Graph V \<Lambda> E" by (metis diagram.exhaust)
   have "S |\<subseteq>| V"
     using "0.prems"(1) initials_in_vertices[of "G"]
     by (auto simp add: G_def)
   have "fcard V \<le> fcard S"
     using "0.prems"(4)
     by (unfold G_def, auto)
   from fcard_seteq[OF \<open>S |\<subseteq>| V\<close> this] have "S = V" by auto
   hence "E = []" using "0.prems"(4) by (unfold G_def, auto)
   have "initials G = V"
     by (unfold G_def \<open>E=[]\<close>, rule no_edges_imp_all_nodes_initial)
   have "terminals G = V"
     by (unfold G_def \<open>E=[]\<close>, rule no_edges_imp_all_nodes_terminal)
   have "{} <+> {} = {}" by auto
   have "lins2 S G = { [] }"
   apply (unfold G_def \<open>S=V\<close> \<open>E=[]\<close>)
   apply (unfold lins2_def, auto simp add: \<open>{} <+> {} = {}\<close>)
   done
   hence \<Pi>_def: "\<Pi> = \<lbrace> initial_ps2 S G \<rbrace>"
     using "0.prems"(3)
     by (auto simp add: ps_chains2_def mk_ps_chain_def)
   show ?case
   apply (intro conjI)
   apply (unfold \<Pi>_def wf_ps_chain_def, auto)
   apply (unfold post.simps initial_ps2_def \<open>initials G = V\<close> \<open>terminals G = V\<close>)
   apply (unfold \<open>S=V\<close>)
   apply (subgoal_tac "V - V = {||}", simp_all)
   done
 next
   case (Suc k)
   obtain V \<Lambda> E where G_def: "G = Graph V \<Lambda> E" by (metis diagram.exhaust)
   from Suc.prems(3) obtain \<pi> where
     \<Pi>_def: "\<Pi> = mk_ps_chain \<lbrace> initial_ps2 S G \<rbrace> \<pi>" and
     \<pi>_in: "\<pi> \<in> lins2 S G"
     by (auto simp add: ps_chains2_def)
   note lins2 = lins2D[OF \<pi>_in]
   have "S |\<subseteq>| V"
     using Suc.prems(1) initials_in_vertices[of "G"]
     by (auto simp add: G_def)
   show ?case
   proof (cases \<pi>)
     case Nil
     from \<pi>_in have "V = S" "E = []"
     apply (-, unfold \<open>\<pi> = []\<close> lins2_def, simp_all)
     apply (unfold empty_eq_Plus_conv)
     apply (unfold G_def vertices.simps edges.simps, auto)
     by (metis \<open>S |\<subseteq>| V\<close> less_eq_fset.rep_eq subset_antisym)
 
     with Suc.prems(4) have False by (simp add: G_def)
     thus ?thesis by auto
   next
     case (Cons x \<pi>')
     note \<pi>_def = this
     show ?thesis
     proof (cases x)
       case (Inl v)
       note x_def = this
 
       have "v |\<notin>| S \<and> v |\<in>| V"
       apply (subgoal_tac "v \<in> fset V - fset S")
       apply (simp)
       apply (subgoal_tac "Inl v \<in> (fset V - fset S) <+> set E")
       apply (metis Inl_inject Inr_not_Inl PlusE)
       apply (metis lins2(1) lins2(2) Cons G_def Inl distinct.simps(2)
         distinct_length_2_or_more edges.simps vertices.simps)
       done
       hence v_notin_S: "v |\<notin>| S" and v_in_V: "v |\<in>| V" by auto
 
       have v_initial_not_S: "v |\<in>| initials G - S"
       apply (simp only: G_def initials_def vertices.simps edges.simps)
       apply (simp only: fminus_iff)
       apply (simp only: conj_commute, intro conjI, rule v_notin_S)
       apply (subgoal_tac
         "v \<in> fset (ffilter (\<lambda>v. \<forall>e\<in>set E. v |\<notin>| thd3 e) V)")
       apply simp
       apply (simp only: filter_fset, simp, simp only: conj_commute)
       apply (intro conjI ballI notI)
       apply (insert v_in_V, simp)
       proof -
         fix e :: edge
         assume "v \<in> fset (thd3 e)"
         then have "v |\<in>| (thd3 e)" by auto
         assume "e \<in> set E"
         hence "Inr e \<in> set \<pi>" using lins2(2) by (auto simp add: G_def)
         then obtain j where
           "j < length \<pi>" "0 < length \<pi>" "\<pi>!j = Inr e" "\<pi>!0 = Inl v"
         by (metis \<pi>_def x_def in_set_conv_nth length_pos_if_in_set nth_Cons_0)
         with lins2(4)[OF this \<open>v |\<in>| (thd3 e)\<close>] show False by auto
       qed
 
       define S' where "S' = {|v|} |\<union>| S"
 
       define \<Pi>' where "\<Pi>' = mk_ps_chain \<lbrace> initial_ps2 S' G \<rbrace> \<pi>'"
       hence pre_\<Pi>': "pre \<Pi>' = initial_ps2 S' G"
       by (metis pre.simps(1) pre_mk_ps_chain)
 
       define \<sigma> where "\<sigma> = [ initials G - ({|v|} |\<union>| S) |=> Top ] ++\<^sub>f [ S |=> Bot ]"
 
       have "wf_ps_chain \<Pi>' \<and> (post \<Pi>' = [terminals G |=> Bot])"
       proof (intro Suc.hyps[of "S'"])
         show "S' |\<subseteq>| initials G"
         apply (unfold S'_def, auto)
         apply (metis fminus_iff v_initial_not_S)
         by (metis Suc.prems(1) fset_rev_mp)
      next
         show "wf_dia G" by (rule Suc.prems(2))
       next
         show "\<Pi>' \<in> ps_chains2 S' G"
         apply (unfold ps_chains2_def \<Pi>'_def)
         apply (intro imageI)
         apply (unfold S'_def)
         apply (intro next_lins2_vertex)
         apply (fold x_def, fold \<pi>_def)
         apply (rule \<pi>_in)
         by (metis v_notin_S)
       next
         show "fcard G^V + length G^E = k + fcard S'"
          apply (unfold S'_def)
          by (auto simp add: Suc.prems(4) fcard_finsert_disjoint[OF v_notin_S])
       qed
       hence
         wf_\<Pi>': "wf_ps_chain \<Pi>'" and
         post_\<Pi>': "post \<Pi>' = [terminals G |=> Bot]"
       by auto
 
       show ?thesis
       proof (intro conjI)
         have 1: "fmdom [ {|v|} |=> Bot ]
         |\<inter>| fmdom ([ initials G - ({|v|} |\<union>| S) |=> Top ] ++\<^sub>f
      [ S |=> Bot ]) = {||}"
         by (metis (no_types) fdom_make_fmap fmdom_add
           bot_least funion_iff finter_finsert_left le_iff_inf
           fminus_iff finsert_fsubset sup_ge1 v_initial_not_S)
         show "wf_ps_chain \<Pi>"
         using [[unfold_abs_def = false]]
         apply (simp only: \<Pi>_def \<pi>_def x_def mk_ps_chain_cons)
         apply simp
         apply (unfold mk_ps_chain_ccons)
         apply (fold next_initial_ps2_vertex S'_def)
         apply (fold \<Pi>'_def)
         apply (unfold wf_ps_chain_def chain_all.simps conj_commute)
         apply (intro conjI)
         apply (fold wf_ps_chain_def, rule wf_\<Pi>')
         apply (intro wf_ps_triple_nodeI exI[of _ "\<sigma>"] conjI)
         apply (unfold \<sigma>_def fmdom_add fdom_make_fmap)
         apply (metis finsertI1 fminus_iff funion_iff v_notin_S)
         apply (unfold pre_\<Pi>' initial_ps2_def S'_def)
         apply (unfold fmap_add_commute[OF 1])
         apply (unfold fmadd_assoc)
         apply (fold fmadd_assoc[of _ "[ S |=> Bot ]"])
         apply (unfold make_fmap_union sup.commute[of "{|v|}"])
         apply (unfold fminus_funion)
         using v_initial_not_S apply auto
         by (metis (opaque_lifting, no_types) finsert_absorb finsert_fminus_single finter_fminus
             inf_commute inf_idem v_initial_not_S)
       next
         show "post \<Pi> = [ terminals G |=> Bot ]"
         apply (unfold \<Pi>_def \<pi>_def x_def mk_ps_chain_cons, simp)
         apply (unfold mk_ps_chain_ccons post.simps)
         apply (fold next_initial_ps2_vertex S'_def)
         apply (fold \<Pi>'_def, rule post_\<Pi>')
         done
       qed
     next
       case (Inr e)
       note x_def = this
       define vs where "vs = fst3 e"
       define ws where "ws = thd3 e"
 
       obtain c where e_def: "e = (vs, c, ws)"
       by (metis vs_def ws_def fst3_simp thd3_simp prod_cases3)
 
       have "linearity E" and "acyclicity E" and
         e_in_V: "\<And>e. e \<in> set E \<Longrightarrow> fst3 e |\<union>| thd3 e |\<subseteq>| V"
       by (insert Suc.prems(2) wf_dia_inv, unfold G_def, blast)+
       note lin = linearityD[OF this(1)]
 
       have acy: "\<And>e. e \<in> set E \<Longrightarrow> fst3 e |\<inter>| thd3 e = {||}"
       apply (fold fset_cong, insert \<open>acyclicity E\<close>)
       apply (unfold acyclicity_def acyclic_def, auto)
       done
 
       note lins = lins2D[OF \<pi>_in]
 
       have e_in_E: "e \<in> set E"
       apply (subgoal_tac "set \<pi> = (fset G^V - fset S) <+> set G^E")
       apply (unfold \<pi>_def x_def G_def edges.simps, auto)[1]
       apply (simp add: lins(2))
       done
 
       have vs_in_S: "vs |\<subseteq>| S"
       apply (insert e_in_V[OF e_in_E])
       apply (unfold less_eq_fset.rep_eq)
       apply (intro subsetI)
       apply (unfold vs_def)
       apply (rule ccontr)
       apply (subgoal_tac "x \<in> fset V")
       prefer 2
       apply (auto)
       proof -
         fix v
         assume a: "v \<in> fset (fst3 e)"
         assume "v \<notin> fset S" and "v \<in> fset V"
         hence "Inl v \<in> set \<pi>"
         by (metis (lifting) DiffI G_def InlI lins(2) vertices.simps)
         then obtain i where
           "i < length \<pi>" "0 < length \<pi>" "\<pi>!i = Inl v"  "\<pi>!0 = Inr e"
         by (metis Cons Inr in_set_conv_nth length_pos_if_in_set nth_Cons_0)
         from lins(3)[OF this] show "False" by (auto simp add: a)
       qed
 
       have "ws |\<inter>| (initials G) = {||}"
       apply (insert e_in_V[OF e_in_E])
       apply (unfold initials_def less_eq_fset.rep_eq, fold fset_cong)
       apply (unfold ws_def G_def, auto simp add: e_in_E)
       done
 
       define S' where "S' = S - vs"
       define V' where "V' = V - vs"
       define E' where "E' = removeAll e E"
       define G' where "G' = Graph V' \<Lambda> E'"
 
       define \<Pi>' where "\<Pi>' = mk_ps_chain \<lbrace> initial_ps2 S' G' \<rbrace> \<pi>'"
       hence pre_\<Pi>': "pre \<Pi>' = initial_ps2 S' G'"
       by (metis pre.simps(1) pre_mk_ps_chain)
 
       define \<sigma> where "\<sigma> = [ initials G - S |=> Top ] ++\<^sub>f [ S - vs |=> Bot ]"
 
       have next_initial_ps2: "initial_ps2 S' G'
         = initial_ps2 S G \<ominus> vs ++\<^sub>f [ws |=> Top]"
       using next_initial_ps2_edge[OF G_def _ _ _ e_in_E _ Suc.prems(1)
         Suc.prems(2)] G'_def E'_def vs_def ws_def V'_def vs_in_S S'_def
       by auto
 
       have "wf_ps_chain \<Pi>' \<and> post \<Pi>' = [ terminals G' |=> Bot ]"
       proof (intro Suc.hyps[of "S'"])
         show "S' |\<subseteq>| initials G'"
         apply (insert Suc.prems(1))
         apply (unfold G'_def G_def initials_def)
         apply (unfold less_eq_fset.rep_eq S'_def E'_def V'_def)
         apply auto
         done
       next
         from Suc.prems(2) have "wf_dia (Graph V \<Lambda> E)"
           by (unfold G_def)
         note wf_G = wf_dia_inv[OF this]
         show "wf_dia G'"
         apply (unfold G'_def V'_def E'_def)
         apply (insert wf_G e_in_E vs_in_S Suc.prems(1))
         apply (unfold vs_def)
         apply (intro wf_dia)
         apply (unfold linearity_def initials_def G_def)
         apply (fold fset_cong, unfold less_eq_fset.rep_eq)
         apply (simp, simp)
         apply (unfold acyclicity_def, rule acyclic_subset)
         apply (auto simp add: distinct_removeAll)
         apply (metis (lifting) IntI empty_iff)
         done
       next
         show "\<Pi>' \<in> ps_chains2 S' G'"
         apply (unfold \<Pi>_def \<Pi>'_def ps_chains2_def)
         apply (intro imageI)
         apply (unfold S'_def G'_def V'_def E'_def)
         apply (intro next_lins2_edge)
         apply (metis \<pi>_def G_def x_def \<pi>_in)
         by (simp only: vs_in_S e_def)+
       next
         have "vs |\<subseteq>| V" by (metis (lifting) \<open>S |\<subseteq>| V\<close> order_trans vs_in_S)
         have "distinct E" using \<open>linearity E\<close> linearity_def by auto
         show "fcard G'^V + length G'^E = k + fcard S'"
         apply (insert Suc.prems(4))
         apply (unfold G_def G'_def vertices.simps edges.simps)
         apply (unfold V'_def E'_def S'_def)
         apply (unfold fcard_funion_fsubset[OF \<open>vs |\<subseteq>| V\<close>])
         apply (unfold fcard_funion_fsubset[OF \<open>vs |\<subseteq>| S\<close>])
         apply (fold distinct_remove1_removeAll[OF \<open>distinct E\<close>])
         apply (unfold length_remove1)
         apply (simp add: e_in_E)
         apply (drule arg_cong[of _ _ "\<lambda>x. x - fcard vs - 1"])
         apply (subst (asm) add_diff_assoc2[symmetric])
         apply (simp add: fcard_mono[OF \<open>vs |\<subseteq>| V\<close>])
         apply (subst add_diff_assoc, insert length_pos_if_in_set[OF e_in_E], arith, auto)
         apply (subst add_diff_assoc, auto simp add: fcard_mono[OF \<open>vs |\<subseteq>| S\<close>])
         done
       qed
       hence
         wf_\<Pi>': "wf_ps_chain \<Pi>'" and
         post_\<Pi>': "post \<Pi>' = [ terminals G' |=> Bot ]"
       by auto
 
       have terms_same: "terminals G = terminals G'"
       apply (unfold G'_def G_def terminals_def edges.simps vertices.simps)
       apply (unfold E'_def V'_def)
       apply (fold fset_cong, auto simp add: e_in_E vs_def)
       done
 
       have 1: "fmdom [ fst3 e |=> Bot ] |\<inter>|
         fmdom([ ffilter (\<lambda>v. \<forall>e\<in>set E. v |\<notin>| thd3 e) V - S |=> Top ]
         ++\<^sub>f [ S - fst3 e |=> Bot ]) = {||}"
       apply (unfold fmdom_add fdom_make_fmap)
       apply (fold fset_cong)
       apply auto
       apply (metis in_mono less_eq_fset.rep_eq vs_def vs_in_S)
       done
 
       show ?thesis
       proof (intro conjI)
         show "wf_ps_chain \<Pi>"
         using [[unfold_abs_def = false]]
         apply (unfold \<Pi>_def \<pi>_def x_def mk_ps_chain_cons)
         apply simp
         apply (unfold mk_ps_chain_ccons)
         apply (fold vs_def ws_def)
         apply (fold next_initial_ps2)
         apply (fold \<Pi>'_def)
         apply (unfold wf_ps_chain_def chain_all.simps conj_commute)
         apply (intro conjI)
         apply (fold wf_ps_chain_def)
         apply (rule wf_\<Pi>')
         apply (intro wf_ps_triple_edgeI exI[of _ "\<sigma>"])
         apply (unfold e_def fst3_simp thd3_simp \<sigma>_def, intro conjI)
         apply (insert Suc.prems(1))
         apply (unfold pre_\<Pi>' initial_ps2_def initials_def)
         apply (insert vs_in_S acy[OF e_in_E])
         apply (fold fset_cong)
         apply (unfold less_eq_fset.rep_eq)[1]
         apply (unfold G_def G'_def vs_def ws_def V'_def E'_def S'_def)
         apply (unfold vertices.simps edges.simps)
         apply (unfold fmap_add_commute[OF 1])
         apply (fold fmadd_assoc)
         apply (unfold make_fmap_union)
         apply (auto simp add: fdom_make_fmap e_in_E)[1]
         apply simp
         apply (unfold fmadd_assoc)
         apply (unfold make_fmap_union)
         apply (metis (lifting) funion_absorb2 vs_def vs_in_S)
         apply (intro arg_cong2[of _ _ "[ S - fst3 e |=> Bot ]"
             "[ S - fst3 e |=> Bot ]" "(++\<^sub>f)"])
         apply (intro arg_cong2[of _ _ "Top" "Top" "make_fmap"])
         defer 1
         apply (simp, simp)
         apply (fold fset_cong)
         apply (unfold less_eq_fset.rep_eq, simp)
         apply (elim conjE)
         apply (intro set_eqI iffI, simp_all)
         apply (elim conjE, intro disjI conjI ballI, simp)
         apply (case_tac "ea=e", simp_all)
         apply (elim disjE conjE, intro conjI ballI impI, simp_all)
         apply (insert e_in_E lin(2))[1]
         apply (subst (asm) (2) fset_cong[symmetric])
         apply (elim conjE)
         apply (subst (asm) inter_fset)
         apply (subst (asm) fset_simps)
         apply (insert disjoint_iff_not_equal)[1]
         apply blast
         apply (metis G_def Suc(3) e_in_E subsetD less_eq_fset.rep_eq wf_dia_inv')
         prefer 2
         apply (metis (lifting) IntI Suc(2) \<open>ws |\<inter>| initials G = {||}\<close>
             empty_iff fset_simps(1) in_mono inter_fset less_eq_fset.rep_eq ws_def)
         apply auto
         done
       next
         show "post \<Pi> = [terminals G |=> Bot]"
         apply (unfold \<Pi>_def \<pi>_def x_def mk_ps_chain_cons)
         apply simp
         apply (unfold mk_ps_chain_ccons post.simps)
         apply (fold vs_def ws_def)
         apply (fold next_initial_ps2)
         apply (fold \<Pi>'_def)
         apply (unfold terms_same)
         apply (rule post_\<Pi>')
         done
       qed
     qed
   qed
 qed
 
 corollary wf_chains:
   assumes "wf_dia G"
   assumes "\<Pi> \<in> ps_chains G"
   shows "wf_ps_chain \<Pi> \<and> post \<Pi> = [ terminals G |=> Bot ]"
 apply (intro wf_chains2[of "{||}"], insert assms(2))
 by (auto simp add: assms(1) ps_chains_is_ps_chains2_with_empty_S fcard_fempty)
 
 
 subsection \<open>Interface chains\<close>
 
 type_synonym int_chain = "(interface, assertion_gadget + command_gadget) chain"
 
 text \<open>An interface chain is similar to a proofstate chain. However, where a
   proofstate chain talks about nodes and edges, an interface chain talks about
   the assertion-gadgets and command-gadgets that label those nodes and edges
   in a diagram. And where a proofstate chain talks about proofstates, an
   interface chain talks about the interfaces obtained from those proofstates.
 
   The following functions convert a proofstate chain into an
   interface chain.\<close>
 
 definition
   ps_to_int :: "[diagram, proofstate] \<Rightarrow> interface"
 where
   "ps_to_int G \<sigma> \<equiv>
     \<Otimes>v |\<in>| fmdom \<sigma>. case_topbot top_ass bot_ass (lookup \<sigma> v) (G^\<Lambda> v)"
 
 definition
   ps_chain_to_int_chain :: "[diagram, ps_chain] \<Rightarrow> int_chain"
 where
   "ps_chain_to_int_chain G \<Pi> \<equiv>
     chainmap (ps_to_int G) ((case_sum (Inl \<circ> G^\<Lambda>) (Inr \<circ> snd3))) \<Pi>"
 
 lemma ps_chain_to_int_chain_simp:
   "ps_chain_to_int_chain (Graph V \<Lambda> E) \<Pi> =
     chainmap (ps_to_int (Graph V \<Lambda> E)) ((case_sum (Inl \<circ> \<Lambda>) (Inr \<circ> snd3))) \<Pi>"
 by (simp add: ps_chain_to_int_chain_def)
 
 subsection \<open>Soundness proof\<close>
 
 text \<open>We assume that @{term wr_com} always returns @{term "{}"}. This is
   equivalent to changing our axiomatization of separation logic such that the
   frame rule has no side-condition. One way to obtain a separation logic
   lacking a side-condition on its frame rule is to use variables-as-
   resource.
 
   We proceed by induction on the proof rules for graphical diagrams. We
   show that: (1) if a diagram @{term G} is provable w.r.t. interfaces
   @{term P} and @{term Q}, then @{term P} and @{term Q} are the top and bottom
   interfaces of @{term G}, and that the Hoare triple @{term "(asn P,
   c, asn Q)"} is provable for each command @{term c} that can be extracted
   from @{term G}; (2) if a command-gadget @{term C} is provable w.r.t.
   interfaces @{term P} and @{term Q}, then the Hoare triple @{term "(asn P,
   c, asn Q)"} is provable for each command @{term c} that can be extracted
   from @{term C}; and (3) if an assertion-gadget @{term A} is provable, and if
   the top and bottom interfaces of @{term A} are @{term P} and @{term Q}
   respectively, then the Hoare triple @{term "(asn P, c, asn Q)"} is provable
   for each command @{term c} that can be extracted from @{term A}.\<close>
 
 
 
 lemma soundness_graphical_helper:
   assumes no_var_interference: "\<And>c. wr_com c = {}"
   shows
     "(prov_dia G P Q \<longrightarrow>
       (P = top_dia G \<and> Q = bot_dia G \<and>
       (\<forall>c. coms_dia G c \<longrightarrow> prov_triple (asn P, c, asn Q))))
    \<and> (prov_com C P Q \<longrightarrow>
       (\<forall>c. coms_com C c \<longrightarrow> prov_triple (asn P, c, asn Q)))
    \<and> (prov_ass A \<longrightarrow>
       (\<forall>c. coms_ass A c \<longrightarrow> prov_triple (asn (top_ass A), c, asn (bot_ass A))))"
 proof (induct rule: prov_dia_prov_com_prov_ass.induct)
   case (Skip p)
   thus ?case
   apply (intro allI impI, elim conjE coms_skip_inv)
   apply (auto simp add: prov_triple.skip)
   done
 next
   case (Exists G P Q x)
   thus ?case
   apply (intro allI impI, elim conjE coms_exists_inv)
   apply (auto simp add: prov_triple.exists)
   done
 next
   case (Basic P c Q)
   thus ?case
   by (intro allI impI, elim conjE coms_basic_inv, auto)
 next
   case (Choice G P Q H)
   thus ?case
   apply (intro allI impI, elim conjE coms_choice_inv)
   apply (auto simp add: prov_triple.choose)
   done
 next
   case (Loop G P)
   thus ?case
   apply (intro allI impI, elim conjE coms_loop_inv)
   apply (auto simp add: prov_triple.loop)
   done
 next
   case (Main G)
   thus ?case
   apply (intro conjI)
   apply (simp, simp)
   apply (intro allI impI)
   apply (elim coms_main_inv, simp)
   proof -
     fix c V \<Lambda> E
     fix \<pi>::"lin"
     fix cs::"command list"
     assume wf_G: "wf_dia (Graph V \<Lambda> E)"
     assume "\<And>v. v \<in> fset V \<Longrightarrow> \<forall>c. coms_ass (\<Lambda> v) c \<longrightarrow>
       prov_triple (asn (top_ass (\<Lambda> v)), c, asn (bot_ass (\<Lambda> v)))"
     hence prov_vertex: "\<And>v c P Q F. \<lbrakk> coms_ass (\<Lambda> v) c; v \<in> fset V;
       P = (top_ass (\<Lambda> v) \<otimes> F) ; Q = (bot_ass (\<Lambda> v) \<otimes> F) \<rbrakk>
       \<Longrightarrow> prov_triple (asn P, c, asn Q)"
     by (auto simp add: prov_triple.frame no_var_interference)
     assume "\<And>e. e \<in> set E \<Longrightarrow> \<forall>c. coms_com (snd3 e) c \<longrightarrow> prov_triple
       (asn (\<Otimes>v|\<in>|fst3 e. bot_ass (\<Lambda> v)),c,asn (\<Otimes>v|\<in>|thd3 e. top_ass (\<Lambda> v)))"
     hence prov_edge: "\<And>e c P Q F. \<lbrakk> e \<in> set E ; coms_com (snd3 e) c ;
       P = ((\<Otimes>v|\<in>|fst3 e. bot_ass (\<Lambda> v)) \<otimes> F) ;
       Q = ((\<Otimes>v|\<in>|thd3 e. top_ass (\<Lambda> v)) \<otimes> F) \<rbrakk>
       \<Longrightarrow> prov_triple (asn P, c, asn Q)"
     by (auto simp add: prov_triple.frame no_var_interference)
     assume len_cs: "length cs = length \<pi>"
     assume "\<forall>i<length \<pi>.
       case_sum (coms_ass \<circ> \<Lambda>) (coms_com \<circ> snd3) (\<pi> ! i) (cs ! i)"
     hence \<pi>_cs: "\<And>i. i < length \<pi> \<Longrightarrow>
       case_sum (coms_ass \<circ> \<Lambda>) (coms_com \<circ> snd3) (\<pi> ! i) (cs ! i)" by auto
     assume G_def: "G = Graph V \<Lambda> E"
     assume c_def: "c = foldr (;;) cs Skip"
     assume \<pi>_lin: "\<pi> \<in> lins (Graph V \<Lambda> E)"
 
     note lins = linsD[OF \<pi>_lin]
 
     define \<Pi> where "\<Pi> = mk_ps_chain \<lbrace> initial_ps G \<rbrace> \<pi>"
 
     have "\<Pi> \<in> ps_chains G" by (simp add: \<pi>_lin \<Pi>_def ps_chains_def G_def)
     hence 1: "post \<Pi> = [ terminals G |=> Bot ]"
       and 2: "chain_all wf_ps_triple \<Pi>"
     by (insert wf_chains G_def wf_G, auto simp add: wf_ps_chain_def)
 
     show "prov_triple (asn (\<Otimes>v|\<in>|initials (Graph V \<Lambda> E). top_ass (\<Lambda> v)),
       foldr (;;) cs Skip, asn (\<Otimes>v|\<in>|terminals (Graph V \<Lambda> E). bot_ass (\<Lambda> v)))"
     using [[unfold_abs_def = false]]
     apply (intro seq_fold[of _ "ps_chain_to_int_chain G \<Pi>"])
     apply (unfold len_cs)
     apply (unfold ps_chain_to_int_chain_def chainmap_preserves_length \<Pi>_def)
     apply (unfold mk_ps_chain_preserves_length, simp)
     apply (unfold pre_chainmap post_chainmap)
     apply (unfold pre_mk_ps_chain pre.simps)
     apply (fold \<Pi>_def, unfold 1)
     apply (unfold initial_ps_def)
     apply (unfold ps_to_int_def)
     apply (unfold fdom_make_fmap)
     apply (unfold G_def labelling.simps, fold G_def)
     apply (subgoal_tac "\<forall>v \<in> fset (initials G). top_ass (\<Lambda> v) =
       case_topbot top_ass bot_ass (lookup [ initials G |=> Top ] v) (\<Lambda> v)")
     apply (unfold iter_hcomp_cong, simp)
     apply (metis lookup_make_fmap topbot.simps(3))
     apply (subgoal_tac "\<forall>v \<in> fset (terminals G). bot_ass (\<Lambda> v) =
       case_topbot top_ass bot_ass (lookup [ terminals G |=> Bot ] v) (\<Lambda> v)")
     apply (unfold iter_hcomp_cong, simp)
     apply (metis lookup_make_fmap topbot.simps(4), simp)
     apply (unfold G_def, fold ps_chain_to_int_chain_simp G_def)
     proof -
       fix i
       assume "i < length \<pi>"
       hence "i < chainlen \<Pi>"
       by (metis \<Pi>_def add_0_left chainlen.simps(1)
         mk_ps_chain_preserves_length)
       hence wf_\<Pi>i: "wf_ps_triple (nthtriple \<Pi> i)"
         by (insert 2, simp add: chain_all_nthtriple)
       show "prov_triple (asn (fst3 (nthtriple (ps_chain_to_int_chain G \<Pi>) i)),
                  cs ! i, asn (thd3 (nthtriple (ps_chain_to_int_chain G \<Pi>) i)))"
       apply (unfold ps_chain_to_int_chain_def)
       apply (unfold nthtriple_chainmap[OF \<open>i < chainlen \<Pi>\<close>])
       apply (unfold fst3_simp thd3_simp)
       proof (cases "\<pi>!i")
         case (Inl v)
 
         have "snd3 (nthtriple \<Pi> i) = Inl v"
         apply (unfold snds_of_triples_form_comlist[OF \<open>i < chainlen \<Pi>\<close>])
         apply (auto simp add: \<Pi>_def comlist_mk_ps_chain Inl)
         done
 
         with wf_\<Pi>i wf_ps_triple_def obtain \<sigma> where
           v_notin_\<sigma>: "v |\<notin>| fmdom \<sigma>" and
           fst_\<Pi>i: "fst3 (nthtriple \<Pi> i) = [ {|v|} |=> Top ] ++\<^sub>f \<sigma>" and
           thd_\<Pi>i: "thd3 (nthtriple \<Pi> i) = [ {|v|} |=> Bot ] ++\<^sub>f \<sigma>" by auto
 
         show "prov_triple (asn (ps_to_int G (fst3 (nthtriple \<Pi> i))),
                    cs ! i, asn (ps_to_int G (thd3 (nthtriple \<Pi> i))))"
         apply (intro prov_vertex[where v=v])
         apply (metis (no_types) Inl \<open>i < length \<pi>\<close> \<pi>_cs o_def sum.simps(5))
         apply (metis (lifting) Inl lins(2) Inl_not_Inr PlusE \<open>i < length \<pi>\<close>
           nth_mem sum.simps(1) vertices.simps)
         apply (unfold fst_\<Pi>i thd_\<Pi>i)
         apply (unfold ps_to_int_def)
         apply (unfold fmdom_add fdom_make_fmap)
         apply (unfold finsert_is_funion[symmetric])
         apply (insert v_notin_\<sigma>)
         apply (unfold iter_hcomp_insert)
         apply (unfold lookup_union2 lookup_make_fmap1)
         apply (unfold G_def labelling.simps)
         apply (subgoal_tac "\<forall>va \<in> fset (fmdom \<sigma>). case_topbot top_ass bot_ass
           (lookup ([ {|v|} |=> Top ] ++\<^sub>f \<sigma>) va) (\<Lambda> va) =
           case_topbot top_ass bot_ass (lookup ([{|v|} |=> Bot] ++\<^sub>f \<sigma>) va)(\<Lambda> va)")
         apply (unfold iter_hcomp_cong, simp)
         apply (metis lookup_union1, simp)
         done
       next
         case (Inr e)
         have "snd3 (nthtriple \<Pi> i) = Inr e"
         apply (unfold snds_of_triples_form_comlist[OF \<open>i < chainlen \<Pi>\<close>])
         apply (auto simp add: \<Pi>_def comlist_mk_ps_chain Inr)
         done
 
         with wf_\<Pi>i wf_ps_triple_def obtain \<sigma> where
           fst_e_disjoint_\<sigma>: "fst3 e |\<inter>| fmdom \<sigma> = {||}" and
           thd_e_disjoint_\<sigma>: "thd3 e |\<inter>| fmdom \<sigma> = {||}" and
           fst_\<Pi>i: "fst3 (nthtriple \<Pi> i) = [ fst3 e |=> Bot ] ++\<^sub>f \<sigma>" and
           thd_\<Pi>i: "thd3 (nthtriple \<Pi> i) = [ thd3 e |=> Top ] ++\<^sub>f \<sigma>"
         by (auto simp add: inf_sup_distrib2)
 
+
+        let ?F = "\<Otimes>v|\<in>|fmdom \<sigma>.
+          case_topbot top_ass bot_ass (lookup ([ fst3 e |=> Bot ] ++\<^sub>f \<sigma>) v) (\<Lambda> v)"
+
         show "prov_triple (asn (ps_to_int G (fst3 (nthtriple \<Pi> i))),
                    cs ! i, asn (ps_to_int G (thd3 (nthtriple \<Pi> i))))"
-        apply (intro prov_edge[where e=e])
-        apply (subgoal_tac "Inr e \<in> set \<pi>")
-        apply (metis Inr_not_Inl PlusE edges.simps lins(2) sum.simps(2))
-        apply (metis Inr \<open>i < length \<pi>\<close> nth_mem)
-        apply (metis (no_types) Inr \<open>i < length \<pi>\<close> \<pi>_cs o_def sum.simps(6))
-        apply (unfold fst_\<Pi>i thd_\<Pi>i)
-        apply (unfold ps_to_int_def)
-        apply (unfold G_def labelling.simps)
-        apply (unfold fmdom_add fdom_make_fmap)
-        apply (insert fst_e_disjoint_\<sigma>)
-        apply (unfold iter_hcomp_union)
-        apply (subgoal_tac "\<forall>v \<in> fset (fst3 e). case_topbot top_ass bot_ass
+        proof (intro prov_edge[where e=e])
+          show "e \<in> set E"
+            apply (subgoal_tac "Inr e \<in> set \<pi>")
+             apply (metis Inr_not_Inl PlusE edges.simps lins(2) sum.simps(2))
+            by (metis Inr \<open>i < length \<pi>\<close> nth_mem)
+        next
+          show "coms_com (snd3 e) (cs ! i)"
+            by (metis (no_types) Inr \<open>i < length \<pi>\<close> \<pi>_cs o_def sum.simps(6))
+        next
+          show "ps_to_int G (fst3 (nthtriple \<Pi> i)) = ((\<Otimes>v|\<in>|fst3 e. bot_ass (\<Lambda> v)) \<otimes> ?F)"
+            unfolding fst_\<Pi>i ps_to_int_def G_def labelling.simps fmdom_add fdom_make_fmap
+            apply (insert fst_e_disjoint_\<sigma>)
+            apply (unfold iter_hcomp_union)
+            apply (subgoal_tac "\<forall>v \<in> fset (fst3 e). case_topbot top_ass bot_ass
           (lookup ([ fst3 e |=> Bot ] ++\<^sub>f \<sigma>) v) (\<Lambda> v) = bot_ass (\<Lambda> v)")
-        apply (unfold iter_hcomp_cong)
-        apply (simp)
-        apply (intro ballI)
-        apply (subgoal_tac "v |\<notin>| fmdom \<sigma>")
-        apply (unfold lookup_union2)
-        apply (metis lookup_make_fmap topbot.simps(4))
-        apply (metis fempty_iff finterI)
-        apply (insert thd_e_disjoint_\<sigma>)
-        apply (unfold iter_hcomp_union)
-        apply (subgoal_tac "\<forall>v \<in> fset (thd3 e). case_topbot top_ass bot_ass
+             apply (unfold iter_hcomp_cong)
+             apply (simp)
+            apply (intro ballI)
+            apply (subgoal_tac "v |\<notin>| fmdom \<sigma>")
+             apply (unfold lookup_union2)
+             apply (metis lookup_make_fmap topbot.simps(4))
+            by (metis fempty_iff finterI)
+        next
+          show "ps_to_int G (thd3 (nthtriple \<Pi> i)) = ((\<Otimes>v|\<in>|thd3 e. top_ass (\<Lambda> v)) \<otimes> ?F)"
+            unfolding thd_\<Pi>i ps_to_int_def G_def labelling.simps fmdom_add fdom_make_fmap
+            apply (insert thd_e_disjoint_\<sigma>)
+            apply (unfold iter_hcomp_union)
+            apply (subgoal_tac "\<forall>v \<in> fset (thd3 e). case_topbot top_ass bot_ass
           (lookup ([ thd3 e |=> Top ] ++\<^sub>f \<sigma>) v) (\<Lambda> v) = top_ass (\<Lambda> v)")
-        apply (unfold iter_hcomp_cong)
-        apply (subgoal_tac "\<forall>v \<in> fset (fmdom \<sigma>). case_topbot top_ass bot_ass
+             apply (unfold iter_hcomp_cong)
+             apply (subgoal_tac "\<forall>v \<in> fset (fmdom \<sigma>). case_topbot top_ass bot_ass
           (lookup ([ thd3 e |=> Top ] ++\<^sub>f \<sigma>) v) (\<Lambda> v) =
           case_topbot top_ass bot_ass (lookup ([fst3 e |=> Bot] ++\<^sub>f \<sigma>) v) (\<Lambda> v)")
-        apply (unfold iter_hcomp_cong)
-        apply simp
-        apply (intro ballI)
-        apply (subgoal_tac "v |\<in>| fmdom \<sigma>")
-        apply (unfold lookup_union1, auto)
-        apply (subgoal_tac "v |\<notin>| fmdom \<sigma>")
-        apply (unfold lookup_union2)
-        apply (metis lookup_make_fmap topbot.simps(3))
-        by (metis fempty_iff finterI)
+              apply (unfold iter_hcomp_cong)
+              apply simp
+            subgoal
+              by (simp add: lookup_union1)
+            subgoal
+              by (simp add: fdisjoint_iff lookup_union2 lookup_make_fmap)
+            done
+        qed
       qed
     qed
   qed
 qed
 
 text \<open>The soundness theorem states that any diagram provable using the
   proof rules for ribbons can be recreated as a valid proof in separation
   logic.\<close>
 
 corollary soundness_graphical:
   assumes "\<And>c. wr_com c = {}"
   assumes "prov_dia G P Q"
   shows "\<forall>c. coms_dia G c \<longrightarrow> prov_triple (asn P, c, asn Q)"
 using soundness_graphical_helper[OF assms(1)] and assms(2) by auto
 
 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,10454 +1,10447 @@
 (***********************************************************************************
  * 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 (metis empty_iff insertE new_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
   apply (metis 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 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
   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"
   by (auto simp add: get_shadow_root_safe_def bind_pure_I option.case_eq_if)
 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 (verit, best) 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 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
     by (metis get_host_ptr_in_heap local.a_shadow_root_valid_def
         local.get_shadow_root_ok local.heap_is_wellformed_def 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
     using \<open>|h \<turnstile> get_tag_name host'|\<^sub>r \<in> safe_shadow_root_element_types\<close> assms(4) by auto
 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
     by (auto simp add: 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'"
+    using disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
     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, opaque_lifting) children_eq2_h2 fin_mono 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)
+         object_ptr_kinds_eq_h2)[1]
+    by (metis (no_types, opaque_lifting) \<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 fsubsetD in_mono object_ptr_kinds_eq_h2)
 
   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 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 (metis (no_types, lifting) IntI \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> children_eq2_h2 empty_iff
              finite_fset is_OK_returns_result_I l_get_child_nodes.get_child_nodes_ptr_in_heap
              local.get_child_nodes_ok local.known_ptrs_known_ptr local.l_get_child_nodes_axioms
              returns_result_select_result sorted_list_of_set.set_sorted_key_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 (metis (mono_tags, lifting) CD.distinct_lists_no_parent \<open>known_ptrs h'\<close>
         \<open>local.CD.a_distinct_lists h2\<close> \<open>type_wf h'\<close> children_eq2_h2 children_eq_h2
         disconnected_nodes_eq_h2 is_OK_returns_result_I l_get_child_nodes.get_child_nodes_ptr_in_heap
         local.get_child_nodes_ok local.get_disconnected_nodes_ok local.known_ptrs_known_ptr
         local.l_get_child_nodes_axioms returns_result_select_result)
   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, opaque_lifting) \<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, opaque_lifting))
   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, opaque_lifting) 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, opaque_lifting) 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'"
     by (smt (verit) \<open>h \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r Some shadow_root_ptr\<close> assms(2)
         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 element_ptr_kinds_eq_h element_ptr_kinds_eq_h2
         finsert_iff funion_finsert_right get_shadow_root_eq2_h2 get_shadow_root_eq_h h'
         local.a_shadow_root_valid_def local.get_shadow_root_ok object_ptr_kinds_eq2_h2
         object_ptr_kinds_eq_h option.sel returns_result_select_result select_result_I2
         shadow_root_ptr_kinds_commutes sup_bot.right_neutral tag_name_eq2_h tag_name_eq2_h2)
   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 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 (verit) assms(1) assms(2) bind_pure_returns_result_I2 finite_fset
                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_set(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 (verit, best) 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_I return_returns_result
              returns_result_select_result)
     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 (verit) 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"
     by (meson DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) disjoint_iff
         local.get_disconnected_nodes_ok local.heap_is_wellformed_one_disc_parent
         returns_result_select_result type_wf)
 
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     by (metis (mono_tags, lifting) "2" "4" known_ptrs local.get_parent_child_dual
         local.get_parent_ok local.get_parent_parent_in_heap returns_result_select_result
         select_result_I2 split_option_ex type_wf)
 
   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 (smt (verit) DocumentMonad.ptr_kinds_ptr_kinds_M bind_pure_returns_result_I2
                local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure node_ptr_inclusion
                return_returns_result select_result_I2 type_wf)
     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 (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
         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_eq returns_result_select_result)
 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 option.distinct(1) returns_result_eq
         returns_result_select_result root
       by (metis (no_types, opaque_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
           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, opaque_lifting) disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2 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, opaque_lifting) children_eq2_h3 object_ptr_kinds_h3_eq3 subsetD)
       by (metis (no_types, opaque_lifting) \<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 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, opaque_lifting) \<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
                       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)
         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, opaque_lifting) children_eq2_h2 in_mono object_ptr_kinds_M_eq3_h2)
       by (metis (no_types, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h2
           disconnected_nodes_h2 disconnected_nodes_h3 document_ptr_kinds_commutes
           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, opaque_lifting) contra_subsetD 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 select_result_I2 subsetD)
       by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h3
           document_ptr_kinds_eq2_h3 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 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, opaque_lifting) 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, opaque_lifting) 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 notin_set_remove1 select_result_I2
           by (metis (no_types, opaque_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, opaque_lifting) "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, opaque_lifting) "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, opaque_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 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, opaque_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 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 (verit) children_eq2_h3 disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2
         disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 finsertCI funion_finsert_right
         h' insert_iff list.simps(15) local.CD.a_all_ptrs_in_heap_def
         local.set_disconnected_nodes_get_disconnected_nodes node_ptr_kinds_eq_h node_ptr_kinds_eq_h2
         node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3 select_result_I2 subsetD subsetI)
   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_remove)
       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"
       by (smt (verit) 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>local.CD.a_all_ptrs_in_heap h\<close>
           disc_nodes_document_ptr_h disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
           disconnected_nodes_eq2_h3 disjoint_iff document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.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, opaque_lifting) "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, opaque_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 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 (verit) Diff_empty Diff_insert0 ElementMonad.ptr_kinds_M_ptr_kinds
         ElementMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) 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
           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 (metis \<open>previous_host \<in> fset (element_ptr_kinds h2)\<close> \<open>previous_host \<noteq> new_element_ptr\<close>
           element_ptr_kinds_eq_h2 select_result_eq shadow_root_eq_h2 tag_name_eq2_h2)
   qed
   then have "a_shadow_root_valid h'"
     by (smt (verit) \<open>type_wf h3\<close> element_ptr_kinds_eq_h3 local.a_shadow_root_valid_def
         local.get_shadow_root_ok returns_result_select_result select_result_I2 shadow_root_eq_h3
         shadow_root_ptr_kinds_eq_h3 tag_name_eq2_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 (verit, del_insts) assms(3) case_prodI h2 local.get_shadow_root_ok mem_Collect_eq
               new_element_ptr new_element_ptr_not_in_heap pair_imageI returns_result_select_result
               select_result_I2 shadow_root_eq_h)
     using shadow_root_none apply auto[1]
     by (metis (no_types, lifting) assms(3) 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 (metis (mono_tags, lifting) \<open>type_wf h2\<close> case_prodI local.get_shadow_root_ok
             mem_Collect_eq pair_imageI returns_result_select_result select_result_I2 shadow_root_eq_h2)
     apply (metis (mono_tags, lifting) case_prodI mem_Collect_eq pair_imageI select_result_eq shadow_root_eq_h2)
     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 (mono_tags, lifting) \<open>type_wf h'\<close> case_prodI element_ptr_kinds_eq_h2
              element_ptr_kinds_eq_h3 local.get_shadow_root_ok mem_Collect_eq pair_imageI
              returns_result_select_result select_result_I2 shadow_root_eq_h3)
     apply (metis (mono_tags, lifting) \<open>type_wf h'\<close> case_prodI element_ptr_kinds_eq_h2
             element_ptr_kinds_eq_h3 local.get_shadow_root_ok mem_Collect_eq pair_imageI
             returns_result_select_result select_result_I2 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, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M
         \<open>parent_child_rel h = parent_child_rel h2\<close>
         children_eq2_h 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, opaque_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
         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 (verit) children_eq2_h3 disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2
         disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 finsertCI funion_finsert_right
         h' local.CD.a_all_ptrs_in_heap_def local.set_disconnected_nodes_get_disconnected_nodes
         node_ptr_kinds_eq_h node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3
         select_result_I2 set_ConsD subsetD subsetI)
   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_remove)
     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, opaque_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>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 (verit) \<open>local.CD.a_all_ptrs_in_heap h\<close> disc_nodes_document_ptr_h
           disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff
           document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.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(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 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
     by (auto simp add: document_ptr_kinds_def)
   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, opaque_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 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_remove)
 
     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 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_remove)
     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 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 (verit, best) ShadowRootMonad.ptr_kinds_ptr_kinds_M \<open>new_shadow_root_ptr \<notin> set |h \<turnstile>
         shadow_root_ptr_kinds_M|\<^sub>r\<close> \<open>type_wf h'\<close> assms(1) assms(2) element_ptr_kinds_eq_h3
         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 local.get_shadow_root_ok
         local.get_shadow_root_shadow_root_ptr_in_heap
         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 returns_result_select_result
         select_result_I2 shadow_root_eq_h shadow_root_eq_h2 shadow_root_eq_h3 shadow_root_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 (verit, best) \<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_h2
             tag_name_eq2_h3 tag_name_eq_h)
       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
       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 (metis (no_types, opaque_lifting) assms(2)
             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_ok
             local.l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms returns_result_select_result
             select_result_I2 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
     by (smt (verit))
   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
diff --git a/thys/Shadow_SC_DOM/Shadow_DOM.thy b/thys/Shadow_SC_DOM/Shadow_DOM.thy
--- a/thys/Shadow_SC_DOM/Shadow_DOM.thy
+++ b/thys/Shadow_SC_DOM/Shadow_DOM.thy
@@ -1,12903 +1,12890 @@
 (***********************************************************************************
  * 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_SC_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(auto dest: get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok split: option.splits)
 
 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"
   apply (auto simp add: get_child_nodes_def a_get_child_nodes_tups_def)[1]
   apply(split CD.get_child_nodes_splits, rule conjI)+
    apply(simp)
   apply(split invoke_splits, rule conjI)+
    apply(simp)
   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)
 
 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 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>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 document_ptr.splits)[1]
     apply(auto simp add: is_character_data_ptr_def 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>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 document_ptr.splits)[1]
    apply(auto simp add: is_element_ptr_def 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>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 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]
   using case_optionE apply fastforce
   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> is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (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)"
   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  intro: is_shadow_root_ptr_kind_obtains
       intro: is_shadow_root_ptr_kind_obtains 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
       simp add: shadow_root_ptr_casts_commute3 delete_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       intro!: delete_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t dest: document_ptr_casts_commute3
       split: option.splits)
 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 (metis is_shadow_root_ptr_implies_kind option.case_eq_if)
 
 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)] type_wf_impl
   by(auto simp add: all_args_def 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"
   apply(auto simp add: l_set_child_nodes_def instances)[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
 
 
 
 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
 
 
 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
       intro: put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_disconnected_nodes_type_wf_preserved 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 HierarchyRequestError else return ());
       prev_shadow_root \<leftarrow> get_shadow_root element_ptr;
       (if prev_shadow_root \<noteq> None then error HierarchyRequestError 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 (metis (no_types, lifting) cast_document_ptr_not_node_ptr(2) element_ptr_kinds_commutes
         finsertE funion_finsert_right node_ptr_kinds_commutes sup_bot.right_neutral)
 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
   using 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_ancestors_si_not_node:
   assumes "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
   assumes "\<not>is_node_ptr_kind ptr"
   shows "ancestors = [ptr]"
   using assms
   by (simp add: get_ancestors_si_def) (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 elim: get_M_document_put_M_shadow_root
       split: option.splits)
 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:
   "cast shadow_root_ptr \<noteq> 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_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:
     "cast shadow_root_ptr \<noteq> 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_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_different_pointers:
   "cast new_shadow_root_ptr \<noteq> 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_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)
 
 lemma new_shadow_root_no_disconnected_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_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
   by(simp add: CD.get_disconnected_nodes_def new_shadow_root_disconnected_nodes)
 
 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_different_pointers:
     "cast new_shadow_root_ptr \<noteq> 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_disconnected_nodes_locs ptr' \<Longrightarrow> r h h'"
   assumes new_shadow_root_no_disconnected_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_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
 
 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 get_disconnected_nodes_locs"
   apply (auto simp add: l_new_shadow_root_get_disconnected_nodes_def)[1]
   using get_disconnected_nodes_new_shadow_root_different_pointers apply fast
   using new_shadow_root_no_disconnected_nodes apply blast
   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);
         disconnected_nodes \<leftarrow> get_disconnected_nodes (cast shadow_root_ptr);
         (if children = [] \<and> disconnected_nodes = []
         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 +
   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
   by(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
       intro: is_shadow_root_ptr_kind_obtains
       simp add: 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]
       elim: is_document_ptr_kind_obtains is_shadow_root_ptr_kind_obtains
       split: if_splits option.splits)[1]
 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 = 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 (cast shadow_root_ptr)"
 
 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 get_root_node_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_host get_host_locs
   defines get_owner_document_tups = "l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document_tups"
     and 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_defs.a_get_owner_document get_root_node get_disconnected_nodes"
     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 =
     "l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.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 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 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_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 get_root_node_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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs get_root_node get_root_node_locs get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for 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\<^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> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_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_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"
     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" +
   assumes get_owner_document_impl: "get_owner_document = a_get_owner_document"
 begin
 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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^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 DocumentClass.known_ptr get_parent get_parent_locs
   DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs get_root_node get_root_node_locs CD.a_get_owner_document get_host get_host_locs get_owner_document get_child_nodes get_child_nodes_locs
   using get_child_nodes_is_l_get_child_nodes[unfolded ShadowRootClass.known_ptr_defs]
   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 = "l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_disconnected_document
 get_disconnected_nodes" and
   get_disconnected_document_locs = "l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_disconnected_document_locs
 get_disconnected_nodes_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>get\_ancestors\_di\<close>
 
 locale l_get_ancestors_di\<^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 +
   l_get_disconnected_document_defs get_disconnected_document get_disconnected_document_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"
     and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 partial_function (dom_prog) a_get_ancestors_di :: "(_::linorder) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   where
     "a_get_ancestors_di 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_di parent_ptr
           | None \<Rightarrow> do {
               document_ptr \<leftarrow> get_disconnected_document node_ptr;
               a_get_ancestors_di (cast document_ptr)
             })
         }
       | None \<Rightarrow> (case cast ptr of
           Some shadow_root_ptr \<Rightarrow> do {
             host \<leftarrow> get_host shadow_root_ptr;
             a_get_ancestors_di (cast host)
           } |
           None \<Rightarrow> return []));
       return (ptr # ancestors)
     }"
 
 definition "a_get_ancestors_di_locs = get_parent_locs \<union> get_host_locs \<union> get_disconnected_document_locs"
 end
 
 locale l_get_ancestors_di_defs =
   fixes get_ancestors_di :: "(_::linorder) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   fixes get_ancestors_di_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_ancestors_di\<^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_disconnected_document +
   l_get_ancestors_di\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_ancestors_di_defs +
   assumes get_ancestors_di_impl: "get_ancestors_di = a_get_ancestors_di"
   assumes get_ancestors_di_locs_impl: "get_ancestors_di_locs = a_get_ancestors_di_locs"
 begin
 lemmas get_ancestors_di_def = a_get_ancestors_di.simps[folded get_ancestors_di_impl]
 lemmas get_ancestors_di_locs_def = a_get_ancestors_di_locs_def[folded get_ancestors_di_locs_impl]
 
 
 lemma get_ancestors_di_pure [simp]:
   "pure (get_ancestors_di ptr) h"
 proof -
   have "\<forall>ptr h h' x. h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>r x \<longrightarrow> h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>h h' \<longrightarrow> h = h'"
   proof (induct rule: a_get_ancestors_di.fixp_induct[folded get_ancestors_di_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 get_disconnected_document_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 (metis is_OK_returns_result_I returns_heap_eq returns_result_eq)
          apply (meson option.simps(3) returns_result_eq)
         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_ancestors_di_ptr:
   assumes "h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>r ancestors"
   shows "ptr \<in> set ancestors"
   using assms
   by(simp add: get_ancestors_di_def) (auto  elim!: bind_returns_result_E2 split: option.splits
       intro!: bind_pure_I)
 
 lemma get_ancestors_di_ptr_in_heap:
   assumes "h \<turnstile> ok (get_ancestors_di ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   by(auto simp add: get_ancestors_di_def check_in_heap_ptr_in_heap elim!: bind_is_OK_E
       dest: is_OK_returns_result_I)
 
 lemma get_ancestors_di_never_empty:
   assumes "h \<turnstile> get_ancestors_di child \<rightarrow>\<^sub>r ancestors"
   shows "ancestors \<noteq> []"
   using assms
   apply(simp add: get_ancestors_di_def)
   by(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I)
 end
 
 global_interpretation l_get_ancestors_di\<^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
   get_disconnected_document get_disconnected_document_locs
   defines get_ancestors_di = a_get_ancestors_di
     and get_ancestors_di_locs = a_get_ancestors_di_locs .
 declare a_get_ancestors_di.simps [code]
 
 interpretation i_get_ancestors_di?: l_get_ancestors_di\<^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_disconnected_document get_disconnected_document_locs get_ancestors_di get_ancestors_di_locs
   by(auto simp add: l_get_ancestors_di\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_ancestors_di\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       get_ancestors_di_def get_ancestors_di_locs_def instances)
 declare l_get_ancestors_di\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_ancestors_di_is_l_get_ancestors [instances]: "l_get_ancestors get_ancestors_di"
   apply(auto simp add: l_get_ancestors_def)[1]
   using get_ancestors_di_ptr_in_heap apply fast
   using get_ancestors_di_ptr apply fast
   done
 
 subsubsection \<open>adopt\_node\<close>
 
 locale l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w_\<^sub>D\<^sub>O\<^sub>M_defs =
   CD: 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 +
   l_get_ancestors_di_defs get_ancestors_di get_ancestors_di_locs
   for get_owner_document :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and remove_child :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_child_locs :: "(_) object_ptr \<Rightarrow> (_) document_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"
     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_ancestors_di :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog"
     and get_ancestors_di_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_adopt_node :: "(_) document_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> (_, unit) dom_prog"
   where
     "a_adopt_node document node = do {
       ancestors \<leftarrow> get_ancestors_di (cast document);
       (if cast node \<in> set ancestors
         then error HierarchyRequestError
         else CD.a_adopt_node document node)}"
 
 definition a_adopt_node_locs ::
   "(_) object_ptr option \<Rightarrow> (_) document_ptr \<Rightarrow> (_) document_ptr \<Rightarrow> (_, unit) dom_prog set"
   where "a_adopt_node_locs = CD.a_adopt_node_locs"
 end
 
 locale l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w_\<^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 get_ancestors_di get_ancestors_di_locs +
   l_adopt_node_defs adopt_node adopt_node_locs +
   l_get_ancestors_di\<^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_disconnected_document
   get_disconnected_document_locs get_ancestors_di get_ancestors_di_locs +
   CD: 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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^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 set_child_nodes
   set_child_nodes_locs remove
   for get_owner_document :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and remove_child :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_child_locs :: "(_) object_ptr \<Rightarrow> (_) document_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"
     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_ancestors_di :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog"
     and get_ancestors_di_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and adopt_node :: "(_) document_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and adopt_node_locs ::
     "(_) object_ptr option \<Rightarrow> (_) document_ptr \<Rightarrow> (_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) document_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M ::
     "(_) object_ptr option \<Rightarrow> (_) document_ptr \<Rightarrow> (_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and known_ptr :: "(_) object_ptr \<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 known_ptrs :: "(_) heap \<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 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 remove :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog" +
   assumes adopt_node_impl: "adopt_node = a_adopt_node"
   assumes adopt_node_locs_impl: "adopt_node_locs = a_adopt_node_locs"
 begin
 lemmas adopt_node_def = a_adopt_node_def[folded adopt_node_impl CD.adopt_node_impl]
 lemmas adopt_node_locs_def = a_adopt_node_locs_def[folded adopt_node_locs_impl CD.adopt_node_locs_impl]
 
 lemma adopt_node_writes:
   "writes (adopt_node_locs |h \<turnstile> get_parent node|\<^sub>r
            |h \<turnstile> get_owner_document (cast node)|\<^sub>r document_ptr) (adopt_node document_ptr node) h h'"
   by(auto simp add: CD.adopt_node_writes adopt_node_def CD.adopt_node_impl[symmetric]
       adopt_node_locs_def CD.adopt_node_locs_impl[symmetric]
       intro!: writes_bind_pure[OF get_ancestors_di_pure])
 
 lemma adopt_node_pointers_preserved:
   "w \<in> adopt_node_locs parent owner_document document_ptr
    \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'"
   using CD.adopt_node_locs_impl CD.adopt_node_pointers_preserved local.adopt_node_locs_def by blast
 lemma adopt_node_types_preserved:
   "w \<in> adopt_node_locs parent owner_document document_ptr
    \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
   using CD.adopt_node_locs_impl CD.adopt_node_types_preserved local.adopt_node_locs_def by blast
 lemma adopt_node_child_in_heap:
   "h \<turnstile> ok (adopt_node document_ptr child) \<Longrightarrow> child |\<in>| node_ptr_kinds h"
   by (smt CD.adopt_node_child_in_heap CD.adopt_node_impl bind_is_OK_E error_returns_heap
       is_OK_returns_heap_E l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M.adopt_node_def l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
       local.get_ancestors_di_pure pure_returns_heap_eq)
 lemma adopt_node_children_subset:
   "h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
      \<Longrightarrow> h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'
      \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> set children' \<subseteq> set children"
   by (smt CD.adopt_node_children_subset CD.adopt_node_impl bind_returns_heap_E error_returns_heap
       local.adopt_node_def local.get_ancestors_di_pure pure_returns_heap_eq)
 end
 
 global_interpretation l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w_\<^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 get_ancestors_di get_ancestors_di_locs
   defines adopt_node = "a_adopt_node"
     and adopt_node_locs = "a_adopt_node_locs"
     and adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = "CD.a_adopt_node"
     and adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = "CD.a_adopt_node_locs"
   .
 interpretation i_adopt_node\<^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
   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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^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 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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def
       adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_adopt_node\<^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_axioms [instances]
 
 interpretation i_adopt_node?: l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 get_ancestors_di
   get_ancestors_di_locs adopt_node adopt_node_locs CD.a_adopt_node CD.a_adopt_node_locs known_ptr
   type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs
   get_host get_host_locs get_disconnected_document get_disconnected_document_locs remove
   by(auto simp add: l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def adopt_node_def
       adopt_node_locs_def instances)
 declare l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 CD.adopt_node_locs_def CD.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 get_ancestors_di get_ancestors_di_locs adopt_node adopt_node_locs
   adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs known_ptrs get_host
   get_host_locs get_disconnected_document get_disconnected_document_locs 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]
 
 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 get_ancestors_di get_ancestors_di_locs adopt_node adopt_node_locs
   adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs known_ptrs get_host
   get_host_locs get_disconnected_document get_disconnected_document_locs 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_di get_ancestors_di_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_di get_ancestors_di_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 =
     "l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_assigned_nodes get_child_nodes get_tag_name get_root_node get_host
 find_slot"
     and assigned_nodes_flatten =
     "l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_assigned_nodes_flatten get_child_nodes get_tag_name get_root_node
 get_host find_slot"
     and 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.a_flatten_dom get_child_nodes get_tag_name get_root_node get_host
 find_slot remove append_child remove_shadow_root"
   .
 
 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_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M *)
   + 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_ptr_disconnected_node_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   where
     "a_ptr_disconnected_node_rel h = (\<lambda>(x, y). (cast x, cast y)) ` {(document_ptr, disconnected_node).
       document_ptr |\<in>| document_ptr_kinds h \<and> disconnected_node \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r}"
 
 lemma a_ptr_disconnected_node_rel_code [code]: "a_ptr_disconnected_node_rel h = set (concat (map
   (\<lambda>ptr. map
     (\<lambda>node. (cast ptr, cast node))
     |h \<turnstile> get_disconnected_nodes ptr|\<^sub>r)
   (sorted_list_of_fset (document_ptr_kinds h)))
 )"
   by(auto simp add: a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_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 ptr_disconnected_node_rel = a_ptr_disconnected_node_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 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 (z3) assms(1) 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 a_ptr_disconnected_node_rel_finite: "finite (a_ptr_disconnected_node_rel h)"
 proof -
   have "a_ptr_disconnected_node_rel h = (\<Union>owner_document \<in> set |h \<turnstile> document_ptr_kinds_M|\<^sub>r.
                  (\<Union>disconnected_node \<in> set |h \<turnstile> get_disconnected_nodes owner_document|\<^sub>r.
 {(cast owner_document, cast disconnected_node)}))"
     by(auto simp add: a_ptr_disconnected_node_rel_def)
   moreover have "finite (\<Union>owner_document \<in> set |h \<turnstile> document_ptr_kinds_M|\<^sub>r.
                     (\<Union>disconnected_node \<in> set |h \<turnstile> get_disconnected_nodes owner_document|\<^sub>r.
 {(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 owner_document, 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 disconnected_node)}))"
     by simp
   ultimately show ?thesis
     by simp
 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
     "h \<turnstile>  get_disconnected_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]
         bind_returns_heap_E2[rotated, OF get_disconnected_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: document_ptr_kinds_eq_h 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' |\<union>| {|cast shadow_root_ptr|}"
     using object_ptr_kinds_eq_h2
     by (auto simp add: document_ptr_kinds_def delete_shadow_root_pointers[OF h'])
   then
   have document_ptr_kinds_eq2_h2: "document_ptr_kinds h' |\<subseteq>| document_ptr_kinds h2"
     using h' delete_shadow_root_pointers
     by auto
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h' |\<subseteq>| shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     apply(auto simp add: shadow_root_ptr_kinds_def document_ptr_kinds_def)[1]
     by auto
   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 document_ptr_kinds_eq_h2
     by (auto simp add: 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. doc_ptr \<noteq> cast shadow_root_ptr \<Longrightarrow> 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[rotated, OF h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by(metis (no_types, lifting))+
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. doc_ptr \<noteq> cast shadow_root_ptr \<Longrightarrow> |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"
-    apply(auto simp add: CD.a_all_ptrs_in_heap_def object_ptr_kinds_eq_h node_ptr_kinds_def
-        children_eq_h disconnected_nodes_eq_h)[1]
-     apply (metis (no_types, lifting) children_eq2_h subsetD)
-    by (metis (no_types, lifting) disconnected_nodes_eq2_h document_ptr_kinds_eq_h
-        in_mono)
-  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(auto dest!: children_eq_h2)[1]
-    using assms(1) children_eq_h local.heap_is_wellformed_children_in_heap node_ptr_kinds_eq_h
-      node_ptr_kinds_eq_h2 apply blast
-     apply (meson \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> local.get_child_nodes_ok local.known_ptrs_known_ptr
-        returns_result_select_result)
-    by (metis (no_types, lifting) \<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>type_wf h2\<close> assms(1) disconnected_nodes_eq2_h2 disconnected_nodes_eq_h document_ptr_kinds_commutes
-        document_ptr_kinds_eq2_h2 fin_mono 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)
+  hence "CD.a_all_ptrs_in_heap h2"
+    by (simp add: children_eq2_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h
+        l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h
+        object_ptr_kinds_eq_h)
+  hence "CD.a_all_ptrs_in_heap h'"
+    by (metis (no_types, opaque_lifting)
+        \<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
+        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 disconnected_nodes_eq2_h2 document_ptr_kinds_eq2_h2
+        fsubsetD h' CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2
+        shadow_root_ptr_kinds_commutes)
 
   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 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 (verit) IntI children_eq2_h2 empty_iff finite_fset fset_mp
         object_ptr_kinds_eq_h2 set_sorted_list_of_set)
 
      apply(auto simp add:  intro!: distinct_concat_map_I)[1]
       apply(case_tac "x = cast shadow_root_ptr")
     using \<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> document_ptr_kinds_commutes
        apply blast
       apply (metis (mono_tags, lifting) \<open>local.CD.a_distinct_lists h2\<close> \<open>type_wf h'\<close>
         disconnected_nodes_eq_h2 is_OK_returns_result_E local.CD.distinct_lists_disconnected_nodes
         local.get_disconnected_nodes_ok select_result_I2)
      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
   proof -
     fix x  and y and xa
     assume a1: "x |\<in>| document_ptr_kinds h'"
     assume a2: "y |\<in>| document_ptr_kinds h'"
     assume a3: "x \<noteq> y"
     assume a4: "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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr"
     assume a5: "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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr"
     assume a6: "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
     assume a7: "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     assume "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
 (insort (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) (sorted_list_of_set (fset (document_ptr_kinds h') -
 {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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr})))))"
     then show False
       using a7 a6 a5 a4 a3 a2 a1 by (metis (no_types) IntI
           distinct_concat_map_E(1)[of "(\<lambda>ptr. |h2 \<turnstile> get_disconnected_nodes ptr|\<^sub>r)"] disconnected_nodes_eq2_h2
           empty_iff finite_fset finsert.rep_eq insert_iff set_sorted_list_of_set
           sorted_list_of_set_insert_remove)
   next
     fix x xa xb
     assume 0: "distinct (concat (map (\<lambda>ptr. |h2 \<turnstile> get_child_nodes ptr|\<^sub>r)
 (sorted_list_of_set (fset (object_ptr_kinds h2)))))"
       and 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
 (insort (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) (sorted_list_of_set (fset (document_ptr_kinds h') -
 {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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr})))))"
       and 2: "(\<Union>x\<in>fset (object_ptr_kinds h2). set |h2 \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
 (\<Union>x\<in>set (insort (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) (sorted_list_of_set (fset (document_ptr_kinds h') -
 {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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr}))). 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"
       apply(cases "xa = cast shadow_root_ptr")
       using \<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> apply blast
       apply(cases "xb = cast shadow_root_ptr")
       using \<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> document_ptr_kinds_commutes
        apply blast
       by (metis (no_types, opaque_lifting) \<open>local.CD.a_distinct_lists h2\<close> \<open>type_wf h'\<close> children_eq2_h2
           disconnected_nodes_eq_h2 fset_rev_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)
   qed
   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]
     by (smt (z3) \<open>h \<turnstile> get_child_nodes (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) \<rightarrow>\<^sub>r []\<close>
         \<open>h \<turnstile> get_disconnected_nodes (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> \<open>local.CD.a_distinct_lists h\<close>
         children_eq2_h children_eq2_h2 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 finsert_iff
         funion_finsert_right local.CD.distinct_lists_no_parent object_ptr_kinds_eq2_h2 object_ptr_kinds_eq_h
         select_result_I2 sup_bot.comm_neutral)
 
   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 \<union> a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_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)
     moreover have "a_ptr_disconnected_node_rel h = a_ptr_disconnected_node_rel h2"
       by (simp add: a_ptr_disconnected_node_rel_def disconnected_nodes_eq2_h document_ptr_kinds_eq_h)
     ultimately show ?thesis
       using \<open>parent_child_rel h = parent_child_rel h2\<close>
       by (smt \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union>
 local.a_ptr_disconnected_node_rel h)\<close> acyclic_subset subset_refl sup_mono)
   qed
   then
   have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_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)
     moreover have "a_ptr_disconnected_node_rel h2 = a_ptr_disconnected_node_rel h'"
       apply(simp add: a_ptr_disconnected_node_rel_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2)
       by (metis (no_types, lifting) \<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_child_nodes (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) \<rightarrow>\<^sub>r []\<close>
           \<open>h \<turnstile> get_disconnected_nodes (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> \<open>local.CD.a_distinct_lists h\<close>
           disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 document_ptr_kinds_commutes is_OK_returns_result_I
           local.CD.distinct_lists_no_parent local.get_disconnected_nodes_ptr_in_heap select_result_I2)
     ultimately 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 \<union> a_ptr_disconnected_node_rel h2)\<close>
       using acyclic_subset order_refl sup_mono
       by (metis (no_types, opaque_lifting))
   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, opaque_lifting) 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, opaque_lifting) 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 (z3) \<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) document_ptr_kinds_commutes
         element_ptr_kinds_eq_h element_ptr_kinds_eq_h2 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\_get\_disconnected\_document\<close>
 
 locale l_get_parent_get_host_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 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_get_disconnected_document get_disconnected_document get_disconnected_document_locs +
   l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
   l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes
   get_child_nodes_locs get_parent get_parent_locs +
   l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs +
   l_get_host get_host get_host_locs +
   l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_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"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma a_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 a_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 a_host_shadow_root_rel_shadow_root
       local.a_host_shadow_root_rel_def split_cong)
 
 lemma a_ptr_disconnected_node_rel_disconnected_node:
   "h \<turnstile> get_disconnected_nodes document \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow> node_ptr \<in> set disc_nodes \<longleftrightarrow>
 (cast document, cast node_ptr) \<in> a_ptr_disconnected_node_rel h"
   apply(auto simp add: a_ptr_disconnected_node_rel_def)[1]
   by (smt CD.get_disconnected_nodes_ptr_in_heap case_prodI is_OK_returns_result_I mem_Collect_eq
       pair_imageI select_result_I2)
 
 lemma a_ptr_disconnected_node_rel_document:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_document node_ptr \<rightarrow>\<^sub>r document \<Longrightarrow>
 (cast document, cast node_ptr) \<in> a_ptr_disconnected_node_rel h"
   apply(auto simp add: a_ptr_disconnected_node_rel_def)[1]
   using disc_doc_disc_node_dual
   by (metis (no_types, lifting) local.a_ptr_disconnected_node_rel_def
       a_ptr_disconnected_node_rel_disconnected_node)
 
 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> (\<And>owner_document disc_nodes node_ptr. parent = cast owner_document \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow> node_ptr \<in> set disc_nodes \<Longrightarrow> P (cast node_ptr))
       \<Longrightarrow> P parent"
   shows "P ptr"
 proof -
   fix ptr
   have "finite (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)"
     using a_host_shadow_root_rel_finite a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_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 a_ptr_disconnected_node_rel_disconnected_node a_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> (\<And>disc_doc disc_node. child = cast disc_node \<Longrightarrow>
 h \<turnstile> get_disconnected_document disc_node \<rightarrow>\<^sub>r disc_doc\<Longrightarrow> P (cast disc_doc))
       \<Longrightarrow> P child"
   shows "P ptr"
 proof -
   fix ptr
   have "finite (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)"
     using a_host_shadow_root_rel_finite a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_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 a_host_shadow_root_rel_host a_ptr_disconnected_node_rel_document
       using assms(1) assms(2) by auto
   qed
 qed
 end
 
 interpretation i_get_parent_get_host_get_disconnected_document_wf?:
   l_get_parent_get_host_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_parent_get_host_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_parent_get_host_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]
 
 
 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 +
   l_get_disconnected_document_defs +
   l_get_disconnected_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> (\<And>owner_document disc_nodes node_ptr. parent = cast owner_document \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow> node_ptr \<in> set disc_nodes \<Longrightarrow>
 P (cast node_ptr))
       \<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> (\<And>disc_doc disc_node. child = cast disc_node \<Longrightarrow>
 h \<turnstile> get_disconnected_document disc_node \<rightarrow>\<^sub>r disc_doc \<Longrightarrow> P (cast disc_doc))
       \<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
 get_disconnected_document get_disconnected_nodes"
   using heap_wellformed_induct_si heap_wellformed_induct_rev_si
   using l_get_parent_get_host_wf_def by blast
 
 
 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 (z3) 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)
     using host apply(auto)[1]
        apply (smt (verit) assms(1) assms(2) bind_pure_returns_result_I2 bind_returns_result_E 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))
       apply (simp add: bind_pure_I)
      apply(auto intro!: bind_pure_returns_result_I)[1]
     apply (smt (verit) assms(2) bind_pure_returns_result_I2 host local.get_shadow_root_ok
         local.get_shadow_root_pure return_returns_result returns_result_eq shadow_root)
     done
 
   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_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(4) step(5) \<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) shadow_root_same_host list.set_intros(2) shadow_root_host_dual
             step.hyps(2) step.prems(3) type_wf)
     next
       case (Some node_child)
       then
       show ?thesis
         using step(4) step(5) \<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
       apply(auto simp add: get_ancestors_si_def elim!: bind_returns_result_E2)[1]
        apply(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I)[1]
       apply(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I)[1]
        apply (metis local.get_ancestors_si_def)
       by (simp add: local.get_ancestors_si_def)
     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(4) 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(4)
     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(4) \<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 "cast shadow_root_child |\<in>| document_ptr_kinds h"
         using  \<open>child |\<in>| object_ptr_kinds h\<close>
         apply(auto simp add: document_ptr_kinds_def image_iff Bex_def split: option.splits)[1]
         by (metis (mono_tags) shadow_root_ptr_casts_commute)
       then
       have "shadow_root_child |\<in>| shadow_root_ptr_kinds h"
         using shadow_root_ptr_kinds_commutes by blast
       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(4) 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(5) tl_ancestors
         using assms(4) dual_order.trans eq_iff returns_result_eq set_ConsD set_subset_Cons
           shadow_root_ptr_casts_commute document_ptr_casts_commute step.prems(1)
         by (smt case_optionE local.shadow_root_host_dual option.case_distrib option.distinct(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(4) 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(4) step(5)
         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(4)
         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_obtains_children_or_shadow_root:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
     and "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<noteq> ptr"
     and "ancestor \<in> set ancestors"
   shows "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
       \<or> ((\<forall>ancestor_element shadow_root. ancestor = cast ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow> cast shadow_root \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis)"
 proof (insert assms(4) assms(5) assms(6), induct ptr arbitrary: ancestors
     rule: heap_wellformed_induct_rev_si[OF assms(1)])
   case (1 child)
   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 child")
     case None
     then obtain shadow_root where shadow_root: "child = 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"
       using 1(4) 1(5) 1(6)
       by(auto simp add: get_ancestors_si_def[of child] elim!: bind_returns_result_E2
           split: option.splits)
     then obtain host where host: "h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host"
       by (metis "1.prems"(1) assms(1) assms(2) assms(3) document_ptr_kinds_commutes
           get_ancestors_si_ptrs_in_heap is_OK_returns_result_E local.get_ancestors_si_ptr local.get_host_ok
           shadow_root_ptr_kinds_commutes)
     then obtain host_ancestors where host_ancestors: "h \<turnstile> get_ancestors_si (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) \<rightarrow>\<^sub>r host_ancestors"
       by (metis "1.prems"(1) assms(1) assms(2) assms(3) get_ancestors_si_also_host get_ancestors_si_ok
           get_ancestors_si_ptrs_in_heap is_OK_returns_result_E local.get_ancestors_si_ptr shadow_root)
     then have "ancestors = cast shadow_root # host_ancestors"
       using 1(4) 1(5) 1(3) None shadow_root host
       by(auto simp add: get_ancestors_si_def[of child, simplified shadow_root]
           elim!: bind_returns_result_E2 dest!: returns_result_eq[OF host] split: option.splits)
     then show ?thesis
     proof (cases "ancestor = cast host")
       case True
       then show ?thesis
         using "1.prems"(1) host local.get_ancestors_si_ptr local.shadow_root_host_dual shadow_root
         by blast
     next
       case False
       have "ancestor \<in> set ancestors"
         using host host_ancestors 1(3) get_ancestors_si_also_host assms(1) assms(2) assms(3)
         using "1.prems"(3) by blast
       then have "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set host_ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis) \<or>
           ((\<forall>ancestor_element shadow_root. ancestor = 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow>
 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 \<in> set host_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
         using "1.hyps"(2) "1.prems"(2) False \<open>ancestors = 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 # host_ancestors\<close>
           host host_ancestors shadow_root
         by auto
       then show ?thesis
         using \<open>ancestors = 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 # host_ancestors\<close> by auto
     qed
   next
     case (Some child_node)
     then obtain parent where parent: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
       using 1(4) 1(5) 1(6)
       by(auto simp add: get_ancestors_si_def[of child] elim!: bind_returns_result_E2
           split: option.splits)
     then obtain parent_ancestors where parent_ancestors: "h \<turnstile> get_ancestors_si parent \<rightarrow>\<^sub>r parent_ancestors"
       by (meson assms(1) assms(2) assms(3) get_ancestors_si_ok is_OK_returns_result_E
           local.get_parent_parent_in_heap)
     then have "ancestors = cast child_node # parent_ancestors"
       using 1(4) 1(5) 1(3) Some
       by(auto simp add: get_ancestors_si_def[of child, simplified Some]
           elim!: bind_returns_result_E2 dest!: returns_result_eq[OF parent] split: option.splits)
     then show ?thesis
     proof (cases "ancestor = parent")
       case True
       then show ?thesis
         by (metis (no_types, lifting) "1.prems"(1) Some local.get_ancestors_si_ptr
             local.get_parent_child_dual node_ptr_casts_commute parent)
     next
       case False
       have "ancestor \<in> set ancestors"
         by (simp add: "1.prems"(3))
       then have "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis) \<or>
          ((\<forall>ancestor_element shadow_root. ancestor = 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow>
 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 \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
         using "1.hyps"(1) "1.prems"(2) False Some \<open>ancestors = 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 child_node # parent_ancestors\<close>
           parent parent_ancestors
         by auto
       then show ?thesis
         using \<open>ancestors = 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 child_node # parent_ancestors\<close> by auto
     qed
   qed
 qed
 
 lemma a_host_shadow_root_rel_shadow_root:
   "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root \<Longrightarrow> (cast host, cast shadow_root) \<in> a_host_shadow_root_rel h"
   by(auto simp add: is_OK_returns_result_I get_shadow_root_ptr_in_heap a_host_shadow_root_rel_def)
 
 lemma get_ancestors_si_parent_child_a_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"
   shows "(ptr, child) \<in> (parent_child_rel h \<union> a_host_shadow_root_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 proof
   assume "(ptr, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<^sup>* "
   then show "ptr \<in> set ancestors"
   proof (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(4)] \<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
 next
   assume "ptr \<in> set ancestors"
   then show "(ptr, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<^sup>*"
   proof (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
         by simp
     next
       case False
       have "\<And>thesis. ((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
       \<or> ((\<forall>ancestor_element shadow_root. ptr = cast ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow> cast shadow_root \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis)"
         using "1.prems" False assms(1) assms(2) assms(3) assms(4) get_ancestors_si_obtains_children_or_shadow_root
         by blast
       then show ?thesis
       proof (cases "\<forall>thesis. ((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)")
         case True
         then obtain children ancestor_child
           where "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
             and "ancestor_child \<in> set children"
             and "cast ancestor_child \<in> set ancestors"
           by blast
         then show ?thesis
           by (meson "1.hyps"(1) in_rtrancl_UnI local.CD.parent_child_rel_child r_into_rtrancl rtrancl_trans)
       next
         case False
         obtain ancestor_element shadow_root
           where "ptr = cast ancestor_element"
             and "h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root"
             and "cast shadow_root \<in> set ancestors"
           using False \<open>\<And>thesis. ((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis) \<or>
 ((\<forall>ancestor_element shadow_root. 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow>
 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 \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)\<close>
           by blast
 
         then show ?thesis
           using 1(2) a_host_shadow_root_rel_shadow_root
           apply(simp)
           by (meson Un_iff converse_rtrancl_into_rtrancl)
       qed
     qed
   qed
 qed
 
 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(4)
       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(4)
       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(4) 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
 
 lemma get_root_node_si_parent_child_a_host_shadow_root_rel:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> get_root_node_si ptr \<rightarrow>\<^sub>r root"
   shows "(root, ptr) \<in> (parent_child_rel h \<union> a_host_shadow_root_rel h)\<^sup>*"
   using assms
   using get_ancestors_si_parent_child_a_host_shadow_root_rel get_ancestors_si_never_empty
   by(auto simp add: get_root_node_si_def elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)
 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: 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]
 
 
 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 (verit) 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 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\_ancestors\_di\<close>
 
 locale l_get_ancestors_di_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_ancestors_di\<^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 +
   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_get_parent_get_host_get_disconnected_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_ancestors_di_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_di 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_di_def[of child] assms(1) get_parent_parent_in_heap
         intro!: bind_is_OK_pure_I bind_pure_I split: option.splits)[1]
     using local.get_parent_ok apply blast
     using assms(1) get_disconnected_document_ok apply blast
       apply(simp add: get_ancestors_di_def )
       apply(auto intro!: bind_is_OK_pure_I split: option.splits)[1]
          apply (metis (no_types, lifting) bind_is_OK_E document_ptr_kinds_commutes is_OK_returns_heap_I
         local.get_ancestors_di_def local.get_disconnected_document_disconnected_document_in_heap step.hyps(3))
         apply (metis (no_types, lifting) bind_is_OK_E document_ptr_kinds_commutes is_OK_returns_heap_I
         local.get_ancestors_di_def local.get_disconnected_document_disconnected_document_in_heap step.hyps(3))
     using assms(1) local.get_disconnected_document_disconnected_document_in_heap local.get_host_ok
       shadow_root_ptr_kinds_commutes apply blast
       apply (smt assms(1) bind_returns_heap_E document_ptr_casts_commute2 is_OK_returns_heap_E
         is_OK_returns_heap_I 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
         local.get_disconnected_document_disconnected_document_in_heap local.get_host_pure
         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 option.simps(4) option.simps(5)
         pure_returns_heap_eq shadow_root_ptr_casts_commute2)
     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_di_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors_di 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_di x \<rightarrow>\<^sub>r a # ancestors"
     by(auto simp add: get_ancestors_di_def[of a] elim!: bind_returns_result_E2 split: option.splits)
   then have "x = a"
     by(auto simp add: get_ancestors_di_def[of x] intro!: bind_pure_I 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_di_ptr_in_heap x
       using \<open>x = a\<close> by blast
   next
     case False
     obtain ptr'' where ptr'': "h \<turnstile> get_ancestors_di ptr'' \<rightarrow>\<^sub>r ancestors"
       using \<open> h \<turnstile> get_ancestors_di x \<rightarrow>\<^sub>r a # ancestors\<close> Cons.prems(2) False
       apply(auto simp add: get_ancestors_di_def elim!: bind_returns_result_E2)[1]
        apply(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I)[1]
       apply(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I)[1]
         apply (metis (no_types, lifting) local.get_ancestors_di_def)
        apply (metis (no_types, lifting) local.get_ancestors_di_def)
       by (simp add: local.get_ancestors_di_def)
     then show ?thesis
       using Cons.hyps Cons.prems(2) False by auto
   qed
 qed
 
 lemma get_ancestors_di_reads:
   assumes "heap_is_wellformed h"
   shows "reads get_ancestors_di_locs (get_ancestors_di 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] get_disconnected_document_reads[unfolded reads_def]
     apply(auto simp add: get_ancestors_di_def[of child])[1]
     by(auto simp add: get_ancestors_di_locs_def get_parent_reads_pointers
         intro!: bind_pure_I 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] reads_subset[OF get_disconnected_document_reads]
         split: option.splits list.splits
         )
 
 qed
 
 lemma get_ancestors_di_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors_di 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_di_ptr_in_heap step(4) 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(4)
     by(auto simp add: get_ancestors_di_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(4) \<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_di_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 "cast shadow_root_child |\<in>| document_ptr_kinds h"
         using  \<open>child |\<in>| object_ptr_kinds h\<close>
         apply(auto simp add: document_ptr_kinds_def image_iff Bex_def split: option.splits)[1]
         by (metis (mono_tags, lifting) shadow_root_ptr_casts_commute)
       then
       have "shadow_root_child |\<in>| shadow_root_ptr_kinds h"
         using shadow_root_ptr_kinds_commutes by blast
       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_di (cast host) \<rightarrow>\<^sub>r tl_ancestors"
         using Some step(4) tl_ancestors None
         by(auto simp add: get_ancestors_di_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(5) tl_ancestors
         using assms(4) dual_order.trans eq_iff returns_result_eq set_ConsD set_subset_Cons
           shadow_root_ptr_casts_commute document_ptr_casts_commute step.prems(1)
         by (smt case_optionE local.shadow_root_host_dual option.case_distrib option.distinct(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 obtain disc_doc where disc_doc: "h \<turnstile> get_disconnected_document child_node \<rightarrow>\<^sub>r disc_doc"
         and "h \<turnstile> get_ancestors_di (cast disc_doc) \<rightarrow>\<^sub>r tl_ancestors"
         using step(4) s1 tl_ancestors
         apply(simp add: get_ancestors_di_def[of child])
         by(auto elim!: bind_returns_result_E2 intro!: bind_pure_I split: option.splits dest: returns_result_eq)
       then show ?thesis
         using step(3) step(4) step(5)
         by (metis (no_types, lifting) assms(4) dual_order.trans eq_iff node_ptr_casts_commute s1
             select_result_I2 set_ConsD set_subset_Cons tl_ancestors)
     next
       case (Some parent)
       then
       have "h \<turnstile> get_ancestors_di parent \<rightarrow>\<^sub>r tl_ancestors"
         using s1 tl_ancestors step(4)
         by(auto simp add: get_ancestors_di_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_di 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_di_also_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_di 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_di (cast child) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(4) get_ancestors_di_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_di_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_di_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_di_subset by blast
 qed
 
 lemma get_ancestors_di_also_host:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_di 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_di (cast shadow_root) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(2) assms(3) get_ancestors_di_ok get_ancestors_di_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_di_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_di_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_di_subset by blast
 qed
 
 lemma get_ancestors_di_also_disconnected_document:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_di some_ptr \<rightarrow>\<^sub>r ancestors"
     and "cast disc_node \<in> set ancestors"
     and "h \<turnstile> get_disconnected_document disc_node \<rightarrow>\<^sub>r disconnected_document"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
     and "h \<turnstile> get_parent disc_node \<rightarrow>\<^sub>r None"
   shows "cast disconnected_document \<in> set ancestors"
 proof -
   obtain child_ancestors where child_ancestors: "h \<turnstile> get_ancestors_di (cast disc_node) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(2) assms(3) get_ancestors_di_ok get_ancestors_di_ptrs_in_heap
         is_OK_returns_result_E known_ptrs type_wf)
   then have "cast disconnected_document \<in> set child_ancestors"
     apply(simp add: get_ancestors_di_def)
     by(auto elim!: bind_returns_result_E2 intro!: bind_pure_I split: option.splits
         dest!: returns_result_eq[OF assms(4)] returns_result_eq[OF assms(7)]
         get_ancestors_di_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_di_subset by blast
 qed
 
 lemma disc_node_disc_doc_dual:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
   assumes "h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes"
   assumes "node_ptr \<in> set disc_nodes"
   shows "h \<turnstile> get_disconnected_document node_ptr \<rightarrow>\<^sub>r disc_doc"
 proof -
   have "node_ptr |\<in>| node_ptr_kinds h"
     by (meson assms(4) is_OK_returns_result_I local.get_parent_ptr_in_heap)
   then
   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 child_parent_dual[OF assms(1)]
       assms known_ptrs_known_ptr option.simps(3)
       returns_result_eq returns_result_select_result
     by (metis (no_types, lifting) 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 *)
   then have "disc_doc \<in> set (sorted_list_of_set (fset (document_ptr_kinds h)))" and
     "node_ptr \<in> set |h \<turnstile> get_disconnected_nodes disc_doc|\<^sub>r"
     using CD.get_disconnected_nodes_ptr_in_heap assms(5)
       assms(6) 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 (verit) 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 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 \<rightarrow>\<^sub>r candidates"
     by auto
   have "candidates = [disc_doc]"
     apply(rule filter_M_ex1[OF candidates \<open>disc_doc \<in>
 set (sorted_list_of_set (fset (document_ptr_kinds h)))\<close> h5])
     using \<open>node_ptr \<in> set |h \<turnstile> get_disconnected_nodes disc_doc|\<^sub>r\<close>
       \<open>disc_doc \<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 \<open>node_ptr |\<in>| node_ptr_kinds h\<close> candidates
     by(auto simp add: bind_pure_I get_disconnected_document_def
         elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I filter_M_pure_I)
 qed
 
 lemma get_ancestors_di_obtains_children_or_shadow_root_or_disconnected_node:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
     and "h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<noteq> ptr"
     and "ancestor \<in> set ancestors"
   shows "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
       \<or> ((\<forall>ancestor_element shadow_root. ancestor = cast ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow> cast shadow_root \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis)
       \<or> ((\<forall>disc_doc disc_nodes disc_node. ancestor = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
 proof (insert assms(4) assms(5) assms(6), induct ptr arbitrary: ancestors
     rule: heap_wellformed_induct_rev_si[OF assms(1)])
   case (1 child)
   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 child")
     case None
     then obtain shadow_root where shadow_root: "child = 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"
       using 1(4) 1(5) 1(6)
       by(auto simp add: get_ancestors_di_def[of child] elim!: bind_returns_result_E2
           split: option.splits)
     then obtain host where host: "h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host"
       by (metis "1.prems"(1) assms(1) assms(2) assms(3) document_ptr_kinds_commutes
           get_ancestors_di_ptrs_in_heap is_OK_returns_result_E local.get_ancestors_di_ptr local.get_host_ok
           shadow_root_ptr_kinds_commutes)
     then obtain host_ancestors where host_ancestors:
       "h \<turnstile> get_ancestors_di (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) \<rightarrow>\<^sub>r host_ancestors"
       by (metis "1.prems"(1) assms(1) assms(2) assms(3) get_ancestors_di_also_host get_ancestors_di_ok
           get_ancestors_di_ptrs_in_heap is_OK_returns_result_E local.get_ancestors_di_ptr shadow_root)
     then have "ancestors = cast shadow_root # host_ancestors"
       using 1(4) 1(5) 1(3) None shadow_root host
       by(auto simp add: get_ancestors_di_def[of child, simplified shadow_root]
           elim!: bind_returns_result_E2 dest!: returns_result_eq[OF host] split: option.splits)
     then show ?thesis
     proof (cases "ancestor = cast host")
       case True
       then show ?thesis
         using "1.prems"(1) host local.get_ancestors_di_ptr local.shadow_root_host_dual shadow_root
         by blast
     next
       case False
       have "ancestor \<in> set ancestors"
         using host host_ancestors 1(3) get_ancestors_di_also_host assms(1) assms(2) assms(3)
         using "1.prems"(3) by blast
       then have "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set host_ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis) \<or>
           ((\<forall>ancestor_element shadow_root. ancestor = 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow>
 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 \<in> set host_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
   \<or> ((\<forall>disc_doc disc_nodes disc_node. ancestor = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set host_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
         using "1.hyps"(2) "1.prems"(2) False \<open>ancestors = 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 # host_ancestors\<close>
           host host_ancestors shadow_root
         by auto
       then show ?thesis
         using \<open>ancestors = 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 # host_ancestors\<close>
         by auto
     qed
   next
     case (Some child_node)
     then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r parent_opt"
       by (metis (no_types, lifting) "1.prems"(1) assms(1) assms(2) assms(3)
           get_ancestors_di_ptrs_in_heap is_OK_returns_result_E local.get_ancestors_di_ptr
           local.get_parent_ok node_ptr_casts_commute node_ptr_kinds_commutes)
     then show ?thesis
     proof (induct parent_opt)
       case None
       then obtain disc_doc where disc_doc: "h \<turnstile> get_disconnected_document child_node \<rightarrow>\<^sub>r disc_doc"
         by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_disconnected_document_ok)
       then obtain parent_ancestors where parent_ancestors: "h \<turnstile> get_ancestors_di (cast disc_doc) \<rightarrow>\<^sub>r parent_ancestors"
         by (meson assms(1) assms(2) assms(3) document_ptr_kinds_commutes is_OK_returns_result_E
             l_get_ancestors_di_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_di_ok l_get_ancestors_di_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
             local.get_disconnected_document_disconnected_document_in_heap)
       then have "ancestors = cast child_node # parent_ancestors"
         using 1(4) 1(5) 1(6) Some \<open>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 = Some child_node\<close>
         apply(auto simp add: get_ancestors_di_def[of child,
               simplified \<open>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 = Some child_node\<close>] intro!: bind_pure_I
             elim!: bind_returns_result_E2 dest!: returns_result_eq[OF disc_doc] split: option.splits)[1]
          apply (simp add: returns_result_eq)
         by (meson None.prems option.distinct(1) returns_result_eq)
       then show ?thesis
       proof (cases "ancestor = cast disc_doc")
         case True
         then show ?thesis
           by (metis \<open>ancestors = 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 child_node # parent_ancestors\<close> disc_doc
               list.set_intros(1) local.disc_doc_disc_node_dual)
       next
         case False
         have "ancestor \<in> set ancestors"
           by (simp add: "1.prems"(3))
         then have "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis) \<or>
           ((\<forall>ancestor_element shadow_root. ancestor = 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow>
 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 \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
   \<or> ((\<forall>disc_doc disc_nodes disc_node. ancestor = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
           using "1.hyps"(3) "1.prems"(2) False Some \<open>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 = Some child_node\<close>
             \<open>ancestors = 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 child_node # parent_ancestors\<close> disc_doc parent_ancestors
           by auto
         then show ?thesis
           using \<open>ancestors = 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 child_node # parent_ancestors\<close> by auto
       qed
     next
       case (Some option)
       then obtain parent where parent: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
         using 1(4) 1(5) 1(6)
         by(auto simp add: get_ancestors_di_def[of child] intro!: bind_pure_I
             elim!: bind_returns_result_E2 split: option.splits)
       then obtain parent_ancestors where parent_ancestors:
         "h \<turnstile> get_ancestors_di parent \<rightarrow>\<^sub>r parent_ancestors"
         by (meson assms(1) assms(2) assms(3) get_ancestors_di_ok is_OK_returns_result_E
             local.get_parent_parent_in_heap)
       then have "ancestors = cast child_node # parent_ancestors"
         using 1(4) 1(5) 1(6) Some \<open>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 = Some child_node\<close>
         by(auto simp add: get_ancestors_di_def[of child, simplified
               \<open>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 = Some child_node\<close>] dest!:  elim!: bind_returns_result_E2
             dest!: returns_result_eq[OF parent] split: option.splits)
       then show ?thesis
       proof (cases "ancestor = parent")
         case True
         then show ?thesis
           by (metis \<open>ancestors = 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 child_node # parent_ancestors\<close>
               list.set_intros(1) local.get_parent_child_dual parent)
       next
         case False
         have "ancestor \<in> set ancestors"
           by (simp add: "1.prems"(3))
         then have "((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> 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 ancestor_child \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis) \<or>
           ((\<forall>ancestor_element shadow_root. ancestor = 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 ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow> 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 \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
   \<or> ((\<forall>disc_doc disc_nodes disc_node. ancestor = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set parent_ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
           using "1.hyps"(1) "1.prems"(2) False Some \<open>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 = Some child_node\<close>
             \<open>ancestors = 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 child_node # parent_ancestors\<close> parent parent_ancestors
           by auto
         then show ?thesis
           using \<open>ancestors = 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 child_node # parent_ancestors\<close>
           by auto
       qed
     qed
   qed
 qed
 
 lemma get_ancestors_di_parent_child_a_host_shadow_root_rel:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> get_ancestors_di child \<rightarrow>\<^sub>r ancestors"
   shows "(ptr, child) \<in> (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 proof
   assume "(ptr, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>* "
   then show "ptr \<in> set ancestors"
   proof (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) get_ancestors_di_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 \<union> a_ptr_disconnected_node_rel h) \<and>
 (ptr_child, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
         using converse_rtranclE[OF 1(4)] \<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 \<union> a_ptr_disconnected_node_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_di_also_parent assms \<open>type_wf h\<close> by blast
       next
         case False
         then show ?thesis
         proof (cases "(ptr, ptr_child) \<in> a_host_shadow_root_rel h")
           case True
           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 False True
             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 \<union> a_ptr_disconnected_node_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_di_also_host assms(1) assms(2) assms(3) assms(4) host
             by blast
         next
           case False
           then
           obtain disc_doc where disc_doc: "ptr = 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 disc_doc"
             using ptr_child \<open>(ptr, ptr_child) \<notin> parent_child_rel h\<close>
             by(auto simp add: a_ptr_disconnected_node_rel_def)
           then obtain disc_node disc_nodes where disc_nodes:
             "h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes"
             and disc_node: "disc_node \<in> set disc_nodes"
             and ptr_child_disc_node: "ptr_child = cast disc_node"
             using False \<open>(ptr, ptr_child) \<notin> parent_child_rel h\<close> ptr_child
             apply(auto simp add: a_ptr_disconnected_node_rel_def)[1]
             by (metis (no_types, lifting) CD.get_disconnected_nodes_ok assms(3)
                 returns_result_select_result)
 
           moreover have "(cast disc_node, child) \<in>
 (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
             using ptr_child ptr_child_disc_node by blast
           ultimately have "cast disc_node \<in> set ancestors"
             using "1.hyps"(3) disc_doc by blast
           moreover have "h \<turnstile> get_parent disc_node \<rightarrow>\<^sub>r None"
             using \<open>(ptr, ptr_child) \<notin> parent_child_rel h\<close>
             apply(auto simp add: parent_child_rel_def ptr_child_disc_node)[1]
             by (smt assms(1) assms(2) assms(3) assms(4) calculation disc_node disc_nodes
                 get_ancestors_di_ptrs_in_heap is_OK_returns_result_E local.CD.a_heap_is_wellformed_def
                 local.CD.distinct_lists_no_parent local.CD.heap_is_wellformed_impl local.get_parent_child_dual
                 local.get_parent_ok local.get_parent_parent_in_heap local.heap_is_wellformed_def
                 node_ptr_kinds_commutes select_result_I2 split_option_ex)
           then
           have "h \<turnstile> get_disconnected_document disc_node \<rightarrow>\<^sub>r disc_doc"
             using disc_node_disc_doc_dual disc_nodes disc_node assms(1) assms(2) assms(3)
             by blast
           ultimately show ?thesis
             using \<open>h \<turnstile> get_parent disc_node \<rightarrow>\<^sub>r None\<close> assms(1) assms(2) assms(3) assms(4)
               disc_doc get_ancestors_di_also_disconnected_document
             by blast
         qed
       qed
     qed
   qed
 next
   assume "ptr \<in> set ancestors"
   then show "(ptr, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
   proof (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
         by simp
     next
       case False
       have 2: "\<And>thesis. ((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)
       \<or> ((\<forall>ancestor_element shadow_root. ptr = cast ancestor_element \<longrightarrow>
 h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root \<longrightarrow> cast shadow_root \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow>
 thesis)
       \<or> ((\<forall>disc_doc disc_nodes disc_node. ptr = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)"
         using "1.prems" False assms(1) assms(2) assms(3) assms(4)
           get_ancestors_di_obtains_children_or_shadow_root_or_disconnected_node by blast
       then show ?thesis
       proof (cases "\<forall>thesis. ((\<forall>children ancestor_child. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<longrightarrow>
 ancestor_child \<in> set children \<longrightarrow> cast ancestor_child \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)")
         case True
         then obtain children ancestor_child
           where "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
             and "ancestor_child \<in> set children"
             and "cast ancestor_child \<in> set ancestors"
           by blast
         then show ?thesis
           by (meson "1.hyps"(1) in_rtrancl_UnI local.CD.parent_child_rel_child r_into_rtrancl
               rtrancl_trans)
       next
         case False
         note f1 = this
         then show ?thesis
         proof (cases "\<forall>thesis. ((\<forall>disc_doc disc_nodes disc_node. ptr = cast disc_doc \<longrightarrow>
 h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes \<longrightarrow> disc_node \<in> set disc_nodes \<longrightarrow>
 cast disc_node \<in> set ancestors \<longrightarrow> thesis) \<longrightarrow> thesis)")
           case True
           then obtain disc_doc disc_nodes disc_node
             where "ptr = cast disc_doc"
               and "h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes"
               and "disc_node \<in> set disc_nodes"
               and "cast disc_node \<in> set ancestors"
             by blast
           then show ?thesis
             by (meson "1.hyps"(3) in_rtrancl_UnI
                 local.a_ptr_disconnected_node_rel_disconnected_node r_into_rtrancl rtrancl_trans)
         next
           case False
           then
           obtain ancestor_element shadow_root
             where "ptr = cast ancestor_element"
               and "h \<turnstile> get_shadow_root ancestor_element \<rightarrow>\<^sub>r Some shadow_root"
               and "cast shadow_root \<in> set ancestors"
             using f1 2 by smt
           then show ?thesis
             by (meson "1.hyps"(2) in_rtrancl_UnI local.a_host_shadow_root_rel_shadow_root
                 r_into_rtrancl rtrancl_trans)
         qed
       qed
     qed
   qed
 qed
 end
 interpretation i_get_ancestors_di_wf?: l_get_ancestors_di_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_disconnected_document get_disconnected_document_locs get_ancestors_di
   get_ancestors_di_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
   by(auto simp add: l_get_ancestors_di_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_ancestors_di_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_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using get_root_node_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 (smt bind_is_OK_I2 bind_returns_result_E3 get_disconnected_nodes_pure image_eqI
         is_OK_returns_result_I return_ok return_returns_result select_result_E)
     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 (verit) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
         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 (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_root_in_heap
       by blast
   next
     case False
     have "known_ptr root"
       using assms local.get_root_node_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_root_in_heap
       by blast
 
     show ?thesis
     proof (cases "is_shadow_root_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_root_in_heap
         by blast
     next
       case False
       then have "is_node_ptr_kind root"
         using \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root\<close> \<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_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 option.distinct(1) returns_result_eq
           returns_result_select_result root
         by (metis (no_types, opaque_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
             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
 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"
     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 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
         elim!: bind_returns_result_E2 split: if_splits)
 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(auto simp add: get_owner_document_def a_get_owner_document_tups_def CD.a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, (rule conjI | rule impI)+)+
         apply(auto simp add: known_ptr_impl)[1]
     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 apply blast
     using assms(4)
        apply(auto simp add: 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
         split: option.splits)[1]
     using assms(4)
       apply(auto simp add: 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 split: option.splits)[1]
     using assms(4)
      apply(auto simp add: assms(1) assms(2) assms(3) local.get_ancestors_ok get_disconnected_nodes_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 split: option.splits)[1]
     using assms(4)
     apply(auto simp add: assms(1) assms(2) assms(3) local.get_ancestors_ok get_disconnected_nodes_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 split: option.splits)[1]
     done
 qed
 
 lemma get_owner_document_child_same:
   assumes "heap_is_wellformed h"  "known_ptrs h" "type_wf h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   shows "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow> h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r owner_document"
 proof -
   have "ptr |\<in>| object_ptr_kinds h"
     by (meson assms(4) is_OK_returns_result_I local.get_child_nodes_ptr_in_heap)
   then have "known_ptr ptr"
     using assms(2) local.known_ptrs_known_ptr by blast
 
   have "cast child |\<in>| object_ptr_kinds h"
     using assms(1) assms(4) assms(5) local.heap_is_wellformed_children_in_heap node_ptr_kinds_commutes
     by blast
   then
   have "known_ptr (cast child)"
     using assms(2) local.known_ptrs_known_ptr by blast
   then have "is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (cast child) \<or> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (cast child)"
     by(auto simp add: known_ptr_impl NodeClass.a_known_ptr_def ElementClass.a_known_ptr_def
         CharacterDataClass.a_known_ptr_def DocumentClass.a_known_ptr_def a_known_ptr_def
         split: option.splits)
   obtain root where root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     by (meson \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.get_root_node_ok)
   then have "h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root"
     using assms(1) assms(2) assms(3) assms(4) assms(5) local.child_parent_dual local.get_root_node_parent_same
     by blast
 
   have "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow> h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \<rightarrow>\<^sub>r owner_document"
   proof (cases "is_document_ptr ptr")
     case True
     then obtain document_ptr where document_ptr: "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 document_ptr = ptr"
       using case_optionE document_ptr_casts_commute by blast
     then have "root = cast document_ptr"
       using root
       by(auto simp add: get_root_node_def get_ancestors_def elim!: bind_returns_result_E2
           split: option.splits)
 
     then have "h \<turnstile> 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 document_ptr () \<rightarrow>\<^sub>r owner_document \<longleftrightarrow>
 h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \<rightarrow>\<^sub>r owner_document"
       using document_ptr \<open>h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root\<close>[simplified \<open>root = cast document_ptr\<close>
           document_ptr]
       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 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 dest!: bind_returns_result_E3[rotated, OF
             \<open>h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root\<close>[simplified \<open>root = cast document_ptr\<close> document_ptr], rotated]
           intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: if_splits option.splits)[1]
       using \<open>ptr |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes by blast
     then show ?thesis
       using \<open>known_ptr ptr\<close>
       apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def
           CD.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[folded known_ptr_impl])
            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)
       using \<open>ptr |\<in>| object_ptr_kinds h\<close> True
       by(auto simp add: document_ptr[symmetric] intro!: bind_pure_returns_result_I
           split: option.splits)
   next
     case False
     then show ?thesis
     proof (cases "is_shadow_root_ptr ptr")
       case True
       then obtain shadow_root_ptr where shadow_root_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 shadow_root_ptr = ptr"
         using case_optionE shadow_root_ptr_casts_commute
         by (metis (no_types, lifting) document_ptr_casts_commute3 is_document_ptr_kind_none option.case_eq_if)
       then have "root = cast shadow_root_ptr"
         using root
         by(auto simp add: get_root_node_def get_ancestors_def elim!: bind_returns_result_E2
             split: option.splits)
 
       then have "h \<turnstile> 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>\<^sub>r owner_document \<longleftrightarrow>
 h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \<rightarrow>\<^sub>r owner_document"
         using shadow_root_ptr \<open>h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root\<close>[simplified \<open>root = cast shadow_root_ptr\<close>
             shadow_root_ptr]
         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 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
             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
             dest!: bind_returns_result_E3[rotated, OF \<open>h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root\<close>[simplified
                 \<open>root = cast shadow_root_ptr\<close> shadow_root_ptr], rotated] intro!: bind_pure_returns_result_I
             filter_M_pure_I bind_pure_I split: if_splits option.splits)[1]
         using \<open>ptr |\<in>| object_ptr_kinds h\<close> shadow_root_ptr_kinds_commutes document_ptr_kinds_commutes
         by blast
       then show ?thesis
         using \<open>known_ptr ptr\<close>
         apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def
             CD.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[folded known_ptr_impl])
              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)
         using \<open>ptr |\<in>| object_ptr_kinds h\<close> True
         using False
         by(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 shadow_root_ptr[symmetric]
             intro!: bind_pure_returns_result_I split: option.splits)
     next
       case False
       then obtain node_ptr where node_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 = ptr"
         using \<open>known_ptr ptr\<close> \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
         by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
             CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
       then 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 owner_document \<longleftrightarrow>
 h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \<rightarrow>\<^sub>r owner_document"
         using root \<open>h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root\<close>
         unfolding CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         by (meson bind_pure_returns_result_I bind_returns_result_E3 local.get_root_node_pure)
       then show ?thesis
         using \<open>known_ptr ptr\<close>
         apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def
             CD.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[folded known_ptr_impl])
              apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl])
              apply(drule(1)  known_ptr_not_character_data_ptr)
              apply(drule(1)  known_ptr_not_element_ptr)
              apply(simp add: NodeClass.known_ptr_defs)
         using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
             apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
         using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
            apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
         using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
           apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
         using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
          apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
         using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False \<open>\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\<close>
         apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
         apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
         by(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I dest!: is_OK_returns_result_I)
     qed
   qed
   then show ?thesis
     using \<open>is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (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 child) \<or> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (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 child)\<close>
     using \<open>cast child |\<in>| object_ptr_kinds h\<close>
     by(auto simp add: get_owner_document_def[of "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 child"]
         a_get_owner_document_tups_def CD.a_get_owner_document_tups_def split: invoke_splits)
 qed
 
 lemma get_owner_document_rel:
   assumes "heap_is_wellformed h"  "known_ptrs h" "type_wf h"
   assumes "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
   assumes "ptr \<noteq> cast owner_document"
   shows "(cast owner_document, ptr) \<in> (parent_child_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
 proof -
   have "ptr |\<in>| object_ptr_kinds h"
     using assms
     by (meson is_OK_returns_result_I local.get_owner_document_ptr_in_heap)
   then
   have "known_ptr ptr"
     using known_ptrs_known_ptr[OF assms(2)] by simp
   have "is_node_ptr_kind ptr"
   proof (rule ccontr)
     assume "\<not> is_node_ptr_kind ptr"
     then
     show False
       using assms(4) \<open>known_ptr ptr\<close>
       apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def
           CD.a_get_owner_document_tups_def)[1]
       apply(split invoke_splits)+
           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)
       using \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(5)
       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 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
           elim!: bind_returns_result_E2 split: if_splits option.splits)
   qed
   then obtain node_ptr where node_ptr: "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"
     by (metis node_ptr_casts_commute3)
   then 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 owner_document"
     using assms(4) \<open>known_ptr ptr\<close>
     apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def
         CD.a_get_owner_document_tups_def)[1]
     apply(split invoke_splits)+
         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)
     using \<open>ptr |\<in>| object_ptr_kinds h\<close>
     by (auto simp add: is_document_ptr_kind_none)
   then obtain root where root: "h \<turnstile> get_root_node (cast node_ptr) \<rightarrow>\<^sub>r root"
     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)
   then have "root |\<in>| object_ptr_kinds h"
     using assms(1) assms(2) assms(3) local.get_root_node_root_in_heap by blast
   then
   have "known_ptr root"
     using \<open>known_ptrs h\<close> local.known_ptrs_known_ptr by blast
 
   have "(root, cast node_ptr) \<in> (parent_child_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
     using root
     by (simp add: assms(1) assms(2) assms(3) in_rtrancl_UnI local.get_root_node_parent_child_rel)
 
   show ?thesis
   proof (cases "is_document_ptr_kind root")
     case True
     then have "root = cast owner_document"
       using \<open>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\<close> root
       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 is_document_ptr_kind_def
           dest!: bind_returns_result_E3[rotated, OF root, rotated] split: option.splits)
     then have "(root, cast node_ptr) \<in> (parent_child_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
       using assms(1) assms(2) assms(3) in_rtrancl_UnI local.get_root_node_parent_child_rel root
       by blast
     then show ?thesis
       using \<open>root = 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 owner_document\<close> node_ptr by blast
   next
     case False
     then obtain root_node where root_node: "root = 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 root_node"
       using assms(2)   \<open>root |\<in>| object_ptr_kinds h\<close>
       by(auto simp add: known_ptr_impl ShadowRootClass.known_ptr_defs DocumentClass.known_ptr_defs
           CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
           dest!: known_ptrs_known_ptr split: option.splits)
     have "h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node () \<rightarrow>\<^sub>r owner_document"
       using \<open>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\<close> root  False
       apply(auto simp add: root_node 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
           dest!: bind_returns_result_E3[rotated, OF root, rotated] split: option.splits
           intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I)[1]
       by (simp add: assms(1) assms(2) assms(3) local.get_root_node_no_parent local.get_root_node_same_no_parent)
     then
     have "h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
       using \<open>known_ptr root\<close>
       apply(auto simp add: get_owner_document_def CD.a_get_owner_document_tups_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[folded known_ptr_impl])
           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)
       using \<open>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\<close> root
         False \<open>root |\<in>| object_ptr_kinds h\<close>
          apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
       using \<open>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\<close> root
         False \<open>root |\<in>| object_ptr_kinds h\<close>
         apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
       using \<open>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\<close> root
         False \<open>root |\<in>| object_ptr_kinds h\<close>
        apply(auto simp add: root_node intro!: bind_pure_returns_result_I split: option.splits)[1]
       using \<open>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\<close> root
         False \<open>root |\<in>| object_ptr_kinds h\<close>
       apply(auto simp add: root_node intro!: bind_pure_returns_result_I split: option.splits)[1]
       done
     have "\<not> (\<exists>parent\<in>fset (object_ptr_kinds h). root_node \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r)"
       using root_node
       by (metis (no_types, opaque_lifting) assms(1) assms(2) assms(3) local.child_parent_dual
           local.get_child_nodes_ok local.get_root_node_same_no_parent local.known_ptrs_known_ptr
           option.distinct(1) returns_result_eq returns_result_select_result root)
     have "root_node |\<in>| node_ptr_kinds h"
       using assms(1) assms(2) assms(3) local.get_root_node_root_in_heap node_ptr_kinds_commutes root root_node
       by blast
     then have "\<exists>document_ptr\<in>fset (document_ptr_kinds h). root_node \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
       using \<open>\<not> (\<exists>parent\<in>fset (object_ptr_kinds h). root_node \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r)\<close> assms(1)
         local.heap_is_wellformed_children_disc_nodes by blast
     then obtain disc_nodes document_ptr where "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
       and "root_node \<in> set disc_nodes"
       by (meson assms(3) local.get_disconnected_nodes_ok returns_result_select_result)
     then have "document_ptr |\<in>| document_ptr_kinds h"
       by (meson is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap)
     then have "document_ptr = owner_document"
       by (metis \<open>h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes\<close>
           \<open>h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document\<close> \<open>root_node \<in> set disc_nodes\<close> assms(1) assms(2)
           assms(3) local.get_owner_document_disconnected_nodes returns_result_eq root_node)
     then have "(cast owner_document, cast root_node) \<in> a_ptr_disconnected_node_rel h"
       apply(auto simp add: a_ptr_disconnected_node_rel_def)[1]
       using \<open>h \<turnstile> local.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\<close> assms(1)
         assms(2) assms(3) get_owner_document_owner_document_in_heap_node
       by (metis (no_types, lifting) \<open>h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes\<close>
           \<open>root_node \<in> set disc_nodes\<close> case_prodI mem_Collect_eq pair_imageI select_result_I2)
     moreover have "(cast root_node, cast node_ptr) \<in>
 (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
       by (metis assms(1) assms(2) assms(3) in_rtrancl_UnI local.get_root_node_parent_child_rel
           root root_node)
     ultimately show ?thesis
       by (metis (no_types, lifting) assms(1) assms(2) assms(3) in_rtrancl_UnI
           local.get_root_node_parent_child_rel node_ptr r_into_rtrancl root root_node rtrancl_trans)
   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 DocumentClass.type_wf
   get_root_node get_root_node_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 get_ancestors_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 get_child_nodes"
   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
   using get_owner_document_child_same apply (fast, fast)
   done
 
 paragraph \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document_wf_get_root_node_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_root_node_wf +
   l_get_owner_document_wf +
   assumes known_ptr_impl: "known_ptr = a_known_ptr"
 begin
 
 lemma get_root_node_document:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   assumes "is_document_ptr_kind root"
   shows "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r the (cast root)"
 proof -
   have "ptr |\<in>| object_ptr_kinds h"
     using assms(4)
     by (meson is_OK_returns_result_I local.get_root_node_ptr_in_heap)
   then have "known_ptr ptr"
     using assms(3) local.known_ptrs_known_ptr by blast
   {
     assume "is_document_ptr_kind ptr"
     then have "ptr = root"
       using assms(4)
       by(auto simp add: get_root_node_def get_ancestors_def elim!: bind_returns_result_E2
           split: option.splits)
     then have ?thesis
       using \<open>is_document_ptr_kind ptr\<close> \<open>known_ptr ptr\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def
           CD.a_get_owner_document_tups_def)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
           apply(drule(1) known_ptr_not_shadow_root_ptr[folded known_ptr_impl])
           apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl])
           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 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!: bind_pure_returns_result_I split: option.splits)
   }
   moreover
   {
     assume "is_node_ptr_kind ptr"
     then have ?thesis
       using \<open>known_ptr ptr\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def
           CD.a_get_owner_document_tups_def)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
           apply(drule(1) known_ptr_not_shadow_root_ptr[folded known_ptr_impl])
           apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl])
           apply(drule(1) known_ptr_not_character_data_ptr)
           apply(drule(1) known_ptr_not_element_ptr)
           apply(simp add: NodeClass.known_ptr_defs)
          apply(auto split: option.splits)[1]
       using \<open>h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root\<close> assms(5)
       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 is_document_ptr_kind_def
           intro!: bind_pure_returns_result_I  split: option.splits)
   }
   ultimately
   show ?thesis
     using \<open>known_ptr ptr\<close>
     by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
         CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
         split: option.splits)
 qed
 
 lemma get_root_node_same_owner_document:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   shows "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow> h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
 proof -
   have "ptr |\<in>| object_ptr_kinds h"
     by (meson assms(4) is_OK_returns_result_I local.get_root_node_ptr_in_heap)
   have "root |\<in>| object_ptr_kinds h"
     using assms(1) assms(2) assms(3) assms(4) local.get_root_node_root_in_heap by blast
   have "known_ptr ptr"
     using \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(3) local.known_ptrs_known_ptr by blast
   have "known_ptr root"
     using \<open>root |\<in>| object_ptr_kinds h\<close> assms(3) local.known_ptrs_known_ptr by blast
   show ?thesis
   proof (cases "is_document_ptr_kind ptr")
     case True
     then
     have "ptr = root"
       using assms(4)
       apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1]
       by (metis document_ptr_casts_commute3 last_ConsL local.get_ancestors_not_node node_ptr_no_document_ptr_cast)
     then show ?thesis
       by auto
   next
     case False
     then have "is_node_ptr_kind ptr"
       using \<open>known_ptr ptr\<close>
       by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
           CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
           split: option.splits)
     then obtain node_ptr where node_ptr: "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"
       by (metis node_ptr_casts_commute3)
     show ?thesis
     proof
       assume "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
       then 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 owner_document"
         using node_ptr
         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_splits)+
             apply (meson invoke_empty is_OK_returns_result_I)
         by(auto  elim!: bind_returns_result_E2 split: option.splits)
 
       show "h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
       proof (cases "is_document_ptr_kind root")
         case True
         then show ?thesis
         proof (cases "is_shadow_root_ptr root")
           case True
           then
           have "is_shadow_root_ptr root"
             using True \<open>known_ptr root\<close>
             by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
                 CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
                 split: option.splits)
           have "root = cast owner_document"
             using \<open>is_document_ptr_kind root\<close>
             by (smt \<open>h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document\<close> assms(1) assms(2) assms(3) assms(4)
                 document_ptr_casts_commute3 get_root_node_document returns_result_eq)
           then show ?thesis
             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_splits, (rule conjI | rule impI)+)+
             using \<open>is_shadow_root_ptr root\<close> apply blast
             using \<open>root |\<in>| object_ptr_kinds h\<close>
                apply(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 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
                 is_node_ptr_kind_none)
                apply (metis \<open>h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document\<close> assms(1) assms(2) assms(3)
                 case_optionE document_ptr_kinds_def is_shadow_root_ptr_kind_none l_get_owner_document_wf.get_owner_document_owner_document_in_heap local.l_get_owner_document_wf_axioms not_None_eq return_bind shadow_root_ptr_casts_commute3 shadow_root_ptr_kinds_commutes shadow_root_ptr_kinds_def)
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
               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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
              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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
             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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             done
         next
           case False
           then
           have "is_document_ptr root"
             using True \<open>known_ptr root\<close>
             by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
                 CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
           have "root = cast owner_document"
             using True
             by (smt \<open>h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document\<close> assms(1) assms(2) assms(3) assms(4)
                 document_ptr_casts_commute3 get_root_node_document returns_result_eq)
           then show ?thesis
             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_splits, (rule conjI | rule impI)+)+
             using \<open>is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root\<close> apply blast
             using \<open>root |\<in>| object_ptr_kinds h\<close>
                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 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
                 is_node_ptr_kind_none)[1]
                apply (metis \<open>h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document\<close> assms(1) assms(2) assms(3)
                 case_optionE document_ptr_kinds_def is_shadow_root_ptr_kind_none
                 l_get_owner_document_wf.get_owner_document_owner_document_in_heap local.l_get_owner_document_wf_axioms
                 not_None_eq return_bind shadow_root_ptr_casts_commute3 shadow_root_ptr_kinds_commutes shadow_root_ptr_kinds_def)
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
               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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
              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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             using \<open>root |\<in>| object_ptr_kinds h\<close> document_ptr_kinds_commutes
             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 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
                 is_node_ptr_kind_none intro!: bind_pure_returns_result_I)[1]
             done
         qed
       next
         case False
         then have "is_node_ptr_kind root"
           using \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)
         then obtain root_node_ptr where root_node_ptr: "root = 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 root_node_ptr"
           by (metis node_ptr_casts_commute3)
         then have "h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr () \<rightarrow>\<^sub>r owner_document"
           using \<open>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\<close> assms(4)
           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!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1]
            apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent
               local.get_root_node_same_no_parent node_ptr returns_result_eq)
           using \<open>is_node_ptr_kind root\<close> node_ptr returns_result_eq by fastforce
         then show ?thesis
           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_splits, (rule conjI | rule impI)+)+
           using \<open>is_node_ptr_kind root\<close> \<open>known_ptr root\<close>
               apply(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)[1]
           using \<open>is_node_ptr_kind root\<close> \<open>known_ptr root\<close>
              apply(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)[1]
           using \<open>is_node_ptr_kind root\<close> \<open>known_ptr root\<close>
             apply(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)[1]
           using \<open>root |\<in>| object_ptr_kinds h\<close>
           by(auto simp add: root_node_ptr)
       qed
     next
       assume "h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
       show "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
       proof (cases "is_document_ptr_kind root")
         case True
         have "root = cast owner_document"
           using \<open>h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document\<close>
           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_splits)+
               apply (meson invoke_empty is_OK_returns_result_I)
              apply(auto simp add: True 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 elim!: bind_returns_result_E2 split: if_splits option.splits)[1]
             apply(auto simp add: True 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 elim!: bind_returns_result_E2 split: if_splits option.splits)[1]
            apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains
               is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if)
           by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3
               is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if)
         then show ?thesis
           using assms(1) assms(2) assms(3) assms(4) get_root_node_document
           by fastforce
       next
         case False
         then have "is_node_ptr_kind root"
           using \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
         then obtain root_node_ptr where root_node_ptr: "root = 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 root_node_ptr"
           by (metis node_ptr_casts_commute3)
         then have "h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr () \<rightarrow>\<^sub>r owner_document"
           using \<open>h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document\<close>
           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_splits)+
               apply (meson invoke_empty is_OK_returns_result_I)
           by(auto simp add: is_document_ptr_kind_none elim!: bind_returns_result_E2)
         then 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 owner_document"
           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!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1]
           using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent
             local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr
           by fastforce+
         then show ?thesis
           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_splits, (rule conjI | rule impI)+)+
           using node_ptr  \<open>known_ptr ptr\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
 
           by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               intro!: bind_pure_returns_result_I split: option.splits)
       qed
     qed
   qed
 qed
 end
 
 interpretation i_get_owner_document_wf_get_root_node_wf?: l_get_owner_document_wf_get_root_node_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   DocumentClass.known_ptr get_parent get_parent_locs DocumentClass.type_wf get_disconnected_nodes
   get_disconnected_nodes_locs get_root_node get_root_node_locs CD.a_get_owner_document
   get_host get_host_locs get_owner_document get_child_nodes get_child_nodes_locs type_wf known_ptr
   known_ptrs get_ancestors get_ancestors_locs heap_is_wellformed parent_child_rel
   by(auto simp add: l_get_owner_document_wf_get_root_node_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_get_root_node_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_get_root_node_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_get_root_node_wf_is_l_get_owner_document_wf_get_root_node_wf [instances]:
   "l_get_owner_document_wf_get_root_node_wf heap_is_wellformed type_wf known_ptr known_ptrs get_root_node get_owner_document"
   apply(auto simp add: l_get_owner_document_wf_get_root_node_wf_def l_get_owner_document_wf_get_root_node_wf_axioms_def instances)[1]
   using get_root_node_document apply blast
   using get_root_node_same_owner_document apply (blast, blast)
   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 -
   obtain owner_document children_h h2 disconnected_nodes_h where
     owner_document: "h \<turnstile> get_owner_document (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 child) \<rightarrow>\<^sub>r owner_document" and
     children_h: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children_h" and
     child_in_children_h: "child \<in> set children_h" and
     disconnected_nodes_h: "h \<turnstile>  get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disconnected_nodes_h" and
     h2: "h \<turnstile>  set_disconnected_nodes owner_document (child # disconnected_nodes_h) \<rightarrow>\<^sub>h h2" and
     h': "h2 \<turnstile> set_child_nodes ptr (remove1 child children_h) \<rightarrow>\<^sub>h h'"
     using assms(4)
     apply(auto simp add: remove_child_def elim!: bind_returns_heap_E
         dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure]
         pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1]
     using pure_returns_heap_eq by fastforce
 
   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 "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
     using owner_document children_h child_in_children_h
     using local.get_owner_document_child_same assms by blast
 
   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 document_ptr_kinds_eq: "document_ptr_kinds h = document_ptr_kinds h'"
     using object_ptr_kinds_eq
     by(auto simp add: document_ptr_kinds_def document_ptr_kinds_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 document_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
 
   have "known_ptr ptr"
     using assms(3)
     using children_h get_child_nodes_ptr_in_heap local.known_ptrs_known_ptr by blast
   have "type_wf h2"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'",
         OF set_disconnected_nodes_writes h2]
     using set_disconnected_nodes_types_preserved \<open>type_wf h\<close>
     by(auto simp add: reflp_def transp_def)
 
   have children_eq:
     "\<And>ptr' children. ptr \<noteq> ptr' \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children =
 h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(4)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers
     by fast
   then have children_eq2:
     "\<And>ptr' children. ptr \<noteq> 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 "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children_h"
     apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads
           set_disconnected_nodes_writes h2 children_h] )
     by (simp add: set_disconnected_nodes_get_child_nodes)
 
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r remove1 child children_h"
     using assms(4) owner_document h2 disconnected_nodes_h children_h
     apply(auto simp add: remove_child_def split: if_splits)[1]
     apply(drule bind_returns_heap_E3)
       apply(auto split: if_splits)[1]
      apply(simp)
     apply(auto split: if_splits)[1]
     apply(drule bind_returns_heap_E3)
       apply(auto)[1]
      apply(simp)
     apply(drule bind_returns_heap_E3)
       apply(auto)[1]
      apply(simp)
     apply(drule bind_returns_heap_E4)
       apply(auto)[1]
      apply simp
     using \<open>type_wf h2\<close> set_child_nodes_get_child_nodes \<open>known_ptr ptr\<close> h'
     by blast
 
   have disconnected_nodes_eq: "\<And>ptr' disc_nodes. ptr' \<noteq> owner_document \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
     using local.get_disconnected_nodes_reads set_disconnected_nodes_writes h2
     apply(rule reads_writes_preserved)
     by (metis local.set_disconnected_nodes_get_disconnected_nodes_different_pointers)
   then
   have disconnected_nodes_eq2: "\<And>ptr'. ptr' \<noteq> owner_document \<Longrightarrow>
 |h \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
     by (meson select_result_eq)
   have "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     using h2 local.set_disconnected_nodes_get_disconnected_nodes
     by blast
 
   have disconnected_nodes_eq_h2:
     "\<And>ptr' disc_nodes. h2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h' \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
     using local.get_disconnected_nodes_reads set_child_nodes_writes h'
     apply(rule reads_writes_preserved)
     using local.set_child_nodes_get_disconnected_nodes by blast
   then
   have disconnected_nodes_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h' \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have "a_host_shadow_root_rel h' = a_host_shadow_root_rel h"
     by(auto simp add: a_host_shadow_root_rel_def shadow_root_eq2 element_ptr_kinds_eq)
   moreover
   have "(ptr, cast child) \<in> parent_child_rel h"
     using child_in_children_h children_h local.CD.parent_child_rel_child by blast
   moreover
   have "a_ptr_disconnected_node_rel h' = insert (cast owner_document, cast child) (a_ptr_disconnected_node_rel h)"
     using \<open>h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h\<close> disconnected_nodes_eq2 disconnected_nodes_h
     apply(auto simp add: a_ptr_disconnected_node_rel_def disconnected_nodes_eq2_h2[symmetric] document_ptr_kinds_eq[symmetric])[1]
       apply(case_tac "aa = owner_document")
        apply(auto)[1]
       apply(auto)[1]
      apply (metis (no_types, lifting) assms(4) case_prodI disconnected_nodes_eq_h2 h2
         is_OK_returns_heap_I local.remove_child_in_disconnected_nodes
         local.set_disconnected_nodes_ptr_in_heap mem_Collect_eq owner_document pair_imageI select_result_I2)
     by (metis (no_types, lifting) case_prodI list.set_intros(2) mem_Collect_eq pair_imageI select_result_I2)
   then
   have "a_ptr_disconnected_node_rel h' = a_ptr_disconnected_node_rel h \<union> {(cast owner_document, cast child)}"
     by auto
   moreover have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)"
     using assms(1) local.heap_is_wellformed_def by blast
   moreover have "parent_child_rel h' = parent_child_rel h - {(ptr, cast child)}"
     apply(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq children_eq2)[1]
       apply (metis (no_types, lifting) children_eq2 children_h children_h' notin_set_remove1 select_result_I2)
     using \<open>h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h\<close>
       \<open>heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'\<close> disconnected_nodes_eq_h2 local.CD.distinct_lists_no_parent
       local.CD.heap_is_wellformed_def apply auto[1]
     by (metis (no_types, lifting) children_eq2 children_h children_h' in_set_remove1 select_result_I2)
 
   moreover have "(cast owner_document, ptr) \<in> (parent_child_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
     using \<open>h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document\<close> get_owner_document_rel
     using assms(1) assms(2) assms(3) by blast
   then have "(cast owner_document, ptr) \<in> (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
     by (metis (no_types, lifting) in_rtrancl_UnI inf_sup_aci(5) inf_sup_aci(7))
   ultimately
   have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')"
     by (smt Un_assoc Un_insert_left Un_insert_right acyclic_insert insert_Diff_single
         insert_absorb2 mk_disjoint_insert prod.inject rtrancl_Un_separator_converseE rtrancl_trans
         singletonD sup_bot.comm_neutral)
 
   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>
     using \<open>acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')\<close>
     apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
         host_shadow_root_rel_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 element_ptr_kinds_eq shadow_root_ptr_kinds_eq
         shadow_root_eq shadow_root_eq2 tag_name_eq tag_name_eq2)
 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 DocumentClass.type_wf get_root_node get_root_node_locs
   CD.a_get_owner_document get_owner_document known_ptrs get_ancestors get_ancestors_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_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   CD: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M _ _ _ _ _ _ _ _ _ adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma adopt_node_removes_first_child: "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                          \<Longrightarrow> h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h'
                          \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r node # children
                          \<Longrightarrow> h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
   by (smt CD.adopt_node_removes_first_child bind_returns_heap_E error_returns_heap
       l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M.adopt_node_def local.CD.adopt_node_impl local.get_ancestors_di_pure
       local.l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms pure_returns_heap_eq)
 lemma adopt_node_document_in_heap: "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                         \<Longrightarrow> h \<turnstile> ok (adopt_node owner_document node)
                         \<Longrightarrow> owner_document |\<in>| document_ptr_kinds h"
   by (metis (no_types, lifting) bind_returns_heap_E document_ptr_kinds_commutes is_OK_returns_heap_E
       is_OK_returns_result_I local.adopt_node_def local.get_ancestors_di_ptr_in_heap)
 end
 
 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_get_owner_document  +
   l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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_root_node +
   l_set_disconnected_nodes_get_child_nodes +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_adopt_node_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 +
   l_get_disconnected_document +
   l_get_ancestors_di\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_ancestors_di_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 CD.adopt_node_def elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF get_ancestors_di_pure, rotated]
         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 CD.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_E2[rotated, OF get_ancestors_di_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
         bind_returns_heap_E4[rotated, OF h', rotated] split: if_splits)[1]
      apply(auto split: if_splits elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF get_ancestors_di_pure, rotated]
         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'"
 proof -
   obtain old_document parent_opt h2 ancestors where
     "h \<turnstile> get_ancestors_di (cast document_ptr) \<rightarrow>\<^sub>r ancestors" and
     "cast child \<notin>  set ancestors" and
     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)
     apply(auto simp add:  adopt_node_def[unfolded CD.adopt_node_def] elim!: bind_returns_heap_E
         dest!: pure_returns_heap_eq[rotated, OF get_ancestors_di_pure])[1]
     apply(split if_splits)
     by(auto simp add:  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)
   then show "heap_is_wellformed h'"
   proof(cases "document_ptr = old_document")
     case True
     then show "heap_is_wellformed h'"
       using h' wellformed_h2 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 CD.l_heap_is_wellformed_axioms \<open>type_wf h2\<close> children_eq2_h2 known_ptrs
           l_heap_is_wellformed.heap_is_wellformed_children_in_heap local.get_child_nodes_ok
           local.known_ptrs_known_ptr node_ptr_kinds_eq3_h2 object_ptr_kinds_h2_eq3 object_ptr_kinds_h_eq3
           returns_result_select_result wellformed_h2)
       by (metis (no_types, opaque_lifting) disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2 select_result_I2 set_remove1_subset
           subsetD)
     then have "CD.a_all_ptrs_in_heap h'"
       by (smt \<open>child \<in> set disc_nodes_old_document_h2\<close> children_eq2_h3 disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq3_h3
           local.CD.a_all_ptrs_in_heap_def local.heap_is_wellformed_disc_nodes_in_heap
           node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 object_ptr_kinds_h3_eq3 select_result_I2 set_ConsD
           subset_code(1) 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, opaque_lifting) \<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 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)
         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>type_wf h'\<close> \<open>CD.a_owner_document_valid h'\<close> CD.heap_is_wellformed_def by blast
 
 
 
     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 document_ptr_kinds_eq_h2: "document_ptr_kinds h2 = document_ptr_kinds h3"
       using object_ptr_kinds_eq_h2
       by(auto simp add: document_ptr_kinds_def)
 
     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 document_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 document_ptr_kinds_eq_h3: "document_ptr_kinds h3 = document_ptr_kinds h'"
       using object_ptr_kinds_eq_h3
       by(auto simp add: document_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 document_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 h' = a_host_shadow_root_rel h3" and
       "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h2"
       by(auto simp add: a_host_shadow_root_rel_def shadow_root_eq2_h2 shadow_root_eq2_h3
           element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h3)
     have "parent_child_rel h' = parent_child_rel h3" and "parent_child_rel h3 = parent_child_rel h2"
       by(auto simp add: CD.parent_child_rel_def children_eq2_h2 children_eq2_h3
           object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3)
 
 
     have "parent_child_rel h2 \<subseteq> parent_child_rel h"
       using h2 parent_opt
     proof (induct parent_opt)
       case None
       then show ?case
         by simp
     next
       case (Some parent)
       then
       have h2: "h \<turnstile> remove_child parent child \<rightarrow>\<^sub>h h2"
         by auto
       have child_nodes_eq_h: "\<And>ptr children. parent \<noteq> ptr \<Longrightarrow>
 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 remove_child_writes h2
         apply(rule reads_writes_preserved)
         apply(auto simp add: remove_child_locs_def)[1]
         by (simp add: set_child_nodes_get_child_nodes_different_pointers)
       moreover obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
         using Some local.get_parent_child_dual by blast
       ultimately show ?thesis
         using object_ptr_kinds_eq_h h2
         apply(auto simp add: CD.parent_child_rel_def split: option.splits)[1]
         apply(case_tac "parent = a")
          apply (metis (no_types, lifting) \<open>type_wf h3\<close> children_eq2_h2 children_eq_h2 known_ptrs
             local.get_child_nodes_ok local.known_ptrs_known_ptr local.remove_child_children_subset
             object_ptr_kinds_h2_eq3 returns_result_select_result subset_code(1) type_wf)
         apply (metis (no_types, lifting) known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr
             returns_result_select_result select_result_I2 type_wf)
         done
     qed
 
     have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h"
       using h2
     proof (induct parent_opt)
       case None
       then show ?case
         by simp
     next
       case (Some parent)
       then
       have h2: "h \<turnstile> remove_child parent child \<rightarrow>\<^sub>h h2"
         by auto
       have "\<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 remove_child_writes h2
         apply(rule reads_writes_preserved)
         apply(auto simp add: remove_child_locs_def)[1]
         by (auto simp add: set_disconnected_nodes_get_shadow_root set_child_nodes_get_shadow_root)
       then show ?case
         apply(auto simp add: a_host_shadow_root_rel_def)[1]
          apply (metis (mono_tags, lifting) Collect_cong \<open>type_wf h2\<close> case_prodE case_prodI
             l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_host_shadow_root_rel_def local.get_shadow_root_ok
             local.a_host_shadow_root_rel_shadow_root returns_result_select_result)
         by (metis (no_types, lifting) Collect_cong case_prodE case_prodI local.get_shadow_root_ok
             local.a_host_shadow_root_rel_def local.a_host_shadow_root_rel_shadow_root returns_result_select_result type_wf)
     qed
 
     have "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast old_document, cast child)}"
       apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2 disconnected_nodes_eq2_h2)[1]
       using disconnected_nodes_eq2_h2  disc_nodes_old_document_h2 disc_nodes_old_document_h3
       using \<open>distinct disc_nodes_old_document_h2\<close>
         apply (metis (no_types, lifting) \<open>child \<notin> set (remove1 child disc_nodes_old_document_h2)\<close>
           case_prodI in_set_remove1 mem_Collect_eq pair_imageI select_result_I2)
       using \<open>child \<notin> set (remove1 child disc_nodes_old_document_h2)\<close> disc_nodes_old_document_h3
        apply auto[1]
       by (metis (no_types, lifting) case_prodI disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 in_set_remove1 mem_Collect_eq pair_imageI select_result_I2)
 
     have "a_ptr_disconnected_node_rel h3 \<subseteq> a_ptr_disconnected_node_rel h"
       using h2 parent_opt
     proof (induct parent_opt)
       case None
       then show ?case
         by(auto simp add: \<open>a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast old_document, cast child)}\<close>)
     next
       case (Some parent)
       then
       have h2: "h \<turnstile> remove_child parent child \<rightarrow>\<^sub>h h2"
         by auto
       then
       obtain children_h h'2 disconnected_nodes_h where
         children_h: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children_h" and
         child_in_children_h: "child \<in> set children_h" and
         disconnected_nodes_h: "h \<turnstile>  get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h" and
         h'2: "h \<turnstile>  set_disconnected_nodes old_document (child # disconnected_nodes_h) \<rightarrow>\<^sub>h h'2" and
         h': "h'2 \<turnstile> set_child_nodes parent (remove1 child children_h) \<rightarrow>\<^sub>h h2"
         using old_document
         apply(auto simp add: remove_child_def elim!: bind_returns_heap_E
             dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure]
             pure_returns_heap_eq[rotated, OF get_child_nodes_pure]
             pure_returns_heap_eq[rotated, OF get_disconnected_nodes_pure] split: if_splits)[1]
         using select_result_I2 by fastforce
 
       have "|h3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
         using object_ptr_kinds_eq_h object_ptr_kinds_eq_h2
         by(auto simp add: document_ptr_kinds_def)
       have disconnected_nodes_eq_h: "\<And>ptr disc_nodes. old_document \<noteq> ptr \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes = h2 \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes"
         using get_disconnected_nodes_reads remove_child_writes h2
         apply(rule reads_writes_preserved)
         apply(auto simp add: remove_child_locs_def)[1]
         using old_document
         by (auto simp add:set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers)
       then
       have foo: "\<And>ptr disc_nodes. old_document \<noteq> ptr \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes = h3 \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes"
         using disconnected_nodes_eq_h2 by simp
       then
       have foo2: "\<And>ptr. old_document \<noteq> ptr \<Longrightarrow> |h \<turnstile> get_disconnected_nodes ptr|\<^sub>r =
 |h3 \<turnstile> get_disconnected_nodes ptr|\<^sub>r"
         by (meson select_result_eq)
       have "h'2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
         using h'2
         using local.set_disconnected_nodes_get_disconnected_nodes by blast
 
       have "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
         using get_disconnected_nodes_reads set_child_nodes_writes h'
           \<open>h'2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r child # disconnected_nodes_h\<close>
         apply(rule reads_writes_separate_forwards)
         using local.set_child_nodes_get_disconnected_nodes by blast
       then have "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h"
         using h3
         using disc_nodes_old_document_h2 disc_nodes_old_document_h3 returns_result_eq
         by fastforce
       have "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h"
         using \<open>|h3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h \<turnstile> document_ptr_kinds_M|\<^sub>r\<close>
         apply(auto simp add: a_ptr_disconnected_node_rel_def )[1]
          apply(case_tac "old_document = aa")
         using disconnected_nodes_h \<open>h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h\<close>
         using foo2
           apply(auto)[1]
         using disconnected_nodes_h \<open>h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h\<close>
         using foo2
          apply(auto)[1]
         apply(case_tac "old_document = aa")
         using disconnected_nodes_h \<open>h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h\<close>
         using foo2
          apply(auto)[1]
         using disconnected_nodes_h \<open>h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h\<close>
         using foo2
         apply(auto)[1]
         done
       then show ?thesis
         by auto
     qed
 
     have "acyclic (parent_child_rel h2 \<union> a_host_shadow_root_rel h2 \<union> a_ptr_disconnected_node_rel h2)"
       using local.heap_is_wellformed_def wellformed_h2 by blast
     then have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)"
       using \<open>a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast old_document, cast child)}\<close>
       by(auto simp add: \<open>parent_child_rel h3 = parent_child_rel h2\<close> \<open>a_host_shadow_root_rel h3 = a_host_shadow_root_rel h2\<close> elim!: acyclic_subset)
     moreover
     have "a_ptr_disconnected_node_rel h' = insert (cast document_ptr, cast child) (a_ptr_disconnected_node_rel h3)"
       using disconnected_nodes_eq2_h3[symmetric] disc_nodes_document_ptr_h3 disc_nodes_document_ptr_h' document_ptr_in_heap[unfolded document_ptr_kinds_eq_h2]
       apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h3[symmetric])[1]
        apply(case_tac "document_ptr = aa")
         apply(auto)[1]
        apply(auto)[1]
       apply(case_tac "document_ptr = aa")
        apply(auto)[1]
       apply(auto)[1]
       done
     moreover have "(cast child, cast document_ptr) \<notin> (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
       using \<open>h \<turnstile> get_ancestors_di (cast document_ptr) \<rightarrow>\<^sub>r ancestors\<close>
         \<open>cast child \<notin>  set ancestors\<close> get_ancestors_di_parent_child_a_host_shadow_root_rel
       using assms(1) known_ptrs type_wf by blast
     moreover have "(cast child, cast document_ptr) \<notin> (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*"
     proof -
       have "(parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3 \<union> local.a_ptr_disconnected_node_rel h3) \<subseteq> (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h)"
         apply(simp add: \<open>parent_child_rel h3 = parent_child_rel h2\<close> \<open>a_host_shadow_root_rel h3 = a_host_shadow_root_rel h2\<close> \<open>a_host_shadow_root_rel h2 = a_host_shadow_root_rel h\<close>)
         using \<open>local.a_ptr_disconnected_node_rel h3 \<subseteq> local.a_ptr_disconnected_node_rel h\<close> \<open>parent_child_rel h2 \<subseteq> parent_child_rel h\<close>
         by blast
       then show ?thesis
         using calculation(3) rtrancl_mono by blast
     qed
     ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')"
       by(auto simp add: \<open>parent_child_rel h' = parent_child_rel h3\<close> \<open>a_host_shadow_root_rel h' = a_host_shadow_root_rel h3\<close>)
 
     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>
       using \<open>acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel 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
 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)[unfolded adopt_node_def CD.adopt_node_def]
     by(auto 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] pure_returns_heap_eq[rotated, OF get_ancestors_di_pure]
         split: option.splits if_splits)
 
   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 i_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_adopt_node_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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   adopt_node_locs\<^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 set_child_nodes
   set_child_nodes_locs remove heap_is_wellformed 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 i_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.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_wf?: l_adopt_node_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 get_ancestors_di
   get_ancestors_di_locs adopt_node adopt_node_locs adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^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 set_child_nodes set_child_nodes_locs get_host
   get_host_locs get_disconnected_document get_disconnected_document_locs remove heap_is_wellformed
   parent_child_rel
   by(auto simp add: l_adopt_node_wf\<^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_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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 get_owner_document get_parent get_parent_locs
   remove_child remove_child_locs remove known_ptrs 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_ancestors_di get_ancestors_di_locs adopt_node adopt_node_locs adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   adopt_node_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   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
   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_di get_ancestors_di_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\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   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 +
   l_get_ancestors_di_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_child_wf2
 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_di 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'"
     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)
 
   obtain old_document parent_opt h'2 (* ancestors *) where
     (*    "h \<turnstile> get_ancestors_di (cast owner_document) \<rightarrow>\<^sub>r ancestors" and
     "cast child \<notin>  set ancestors" and *)
     old_document: "h \<turnstile> get_owner_document (cast node) \<rightarrow>\<^sub>r old_document" and
     parent_opt: "h \<turnstile> get_parent node \<rightarrow>\<^sub>r parent_opt" and
     h'2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> remove_child parent node | None \<Rightarrow> return ()) \<rightarrow>\<^sub>h h'2" and
     h2': "h'2 \<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 old_disc_nodes);
         disc_nodes \<leftarrow> get_disconnected_nodes owner_document;
         set_disconnected_nodes owner_document (node # disc_nodes)
       } else do {
         return ()
       }) \<rightarrow>\<^sub>h h2"
     using h2
     apply(auto simp add:  adopt_node_def[unfolded CD.adopt_node_def] elim!: bind_returns_heap_E
         dest!: pure_returns_heap_eq[rotated, OF get_ancestors_di_pure])[1]
     apply(split if_splits)
     by(auto simp add:  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 "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 shadow_root_eq_h: "\<And>ptr' shadow_root_ptr_opt. h \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
 h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
     using get_shadow_root_reads adopt_node_writes h2
     apply(rule reads_writes_preserved)
     by(auto simp add: adopt_node_locs_def CD.adopt_node_locs_def CD.remove_child_locs_def
         set_child_nodes_get_shadow_root set_disconnected_nodes_get_shadow_root)
   then
   have shadow_root_eq2_h: "\<And>ptr'. |h \<turnstile> get_shadow_root ptr'|\<^sub>r = |h2 \<turnstile> get_shadow_root ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   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_hx: "object_ptr_kinds h = object_ptr_kinds h'2"
     using h'2 apply(simp split: option.splits)
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'", OF CD.remove_child_writes])
     using CD.remove_child_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   have document_ptr_kinds_eq_hx: "document_ptr_kinds h = document_ptr_kinds h'2"
     using object_ptr_kinds_eq_hx
     by(auto simp add: document_ptr_kinds_def document_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_hx: "shadow_root_ptr_kinds h = shadow_root_ptr_kinds h'2"
     using object_ptr_kinds_eq_hx
     by(auto simp add: shadow_root_ptr_kinds_def document_ptr_kinds_def)
   have element_ptr_kinds_eq_hx: "element_ptr_kinds h = element_ptr_kinds h'2"
     using object_ptr_kinds_eq_hx
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
   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 adopt_node_writes h2])
     unfolding adopt_node_locs_def CD.adopt_node_locs_def CD.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 document_ptr_kinds_eq_h: "document_ptr_kinds h = document_ptr_kinds h2"
     using object_ptr_kinds_eq_h
     by(auto simp add: document_ptr_kinds_def 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(auto simp add: shadow_root_ptr_kinds_def document_ptr_kinds_def)
   have element_ptr_kinds_eq_h: "element_ptr_kinds h = element_ptr_kinds h2"
     using object_ptr_kinds_eq_h
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
   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 document_ptr_kinds_eq_h2: "document_ptr_kinds h2 = document_ptr_kinds h3"
     using object_ptr_kinds_eq_h2
     by(auto simp add: document_ptr_kinds_def document_ptr_kinds_def)
   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 document_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 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 document_ptr_kinds_eq_h3: "document_ptr_kinds h3 = document_ptr_kinds h'"
     using object_ptr_kinds_eq_h3
     by(auto simp add: document_ptr_kinds_def document_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 document_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 wellformed_h'2: "heap_is_wellformed h'2"
     using h'2 remove_child_heap_is_wellformed_preserved assms
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
 
   have "known_ptrs h'2"
     using \<open>known_ptrs h\<close> known_ptrs_preserved \<open>object_ptr_kinds h = object_ptr_kinds h'2\<close>
     by blast
 
   have "type_wf h'2"
     using \<open>type_wf h\<close> h'2
     apply(auto split: option.splits)[1]
     apply(drule writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF CD.remove_child_writes])
     using CD.remove_child_types_preserved
     by(auto simp add: reflp_def transp_def )
 
 
   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
 
   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 shadow_root_eq2_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 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 "parent_child_rel h2 \<subseteq> parent_child_rel h"
   proof -
     have "parent_child_rel h'2 \<subseteq> parent_child_rel h"
       using h'2 parent_opt
     proof (induct parent_opt)
       case None
       then show ?case
         by simp
     next
       case (Some parent)
       then
       have h'2: "h \<turnstile> remove_child parent node \<rightarrow>\<^sub>h h'2"
         by auto
       then
       have "parent |\<in>| object_ptr_kinds h"
         using CD.remove_child_ptr_in_heap
         by blast
       have child_nodes_eq_h: "\<And>ptr children. parent \<noteq> ptr \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children =
 h'2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
         using get_child_nodes_reads CD.remove_child_writes h'2
         apply(rule reads_writes_preserved)
         apply(auto simp add: CD.remove_child_locs_def)[1]
         by (simp add: set_child_nodes_get_child_nodes_different_pointers)
       moreover obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
         using Some local.get_parent_child_dual by blast
       moreover obtain children_h'2 where children_h'2: "h'2 \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children_h'2"
         using object_ptr_kinds_eq_hx calculation(2) \<open>parent |\<in>| object_ptr_kinds h\<close> get_child_nodes_ok
         by (metis \<open>type_wf h'2\<close> assms(3) is_OK_returns_result_E local.known_ptrs_known_ptr)
       ultimately show ?thesis
         using object_ptr_kinds_eq_h h2
         apply(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_hx split: option.splits)[1]
         apply(case_tac "parent = a")
         using CD.remove_child_children_subset
          apply (metis (no_types, lifting) assms(2) assms(3) contra_subsetD h'2 select_result_I2)
         by (metis select_result_eq)
     qed
     moreover have "parent_child_rel h2 = parent_child_rel h'2"
     proof(cases "owner_document = old_document")
       case True
       then show ?thesis
         using h2' by simp
     next
       case False
       then obtain h'3 old_disc_nodes disc_nodes_document_ptr_h'3 where
         docs_neq: "owner_document \<noteq> old_document" and
         old_disc_nodes: "h'2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r old_disc_nodes" and
         h'3: "h'2 \<turnstile> set_disconnected_nodes old_document (remove1 node old_disc_nodes) \<rightarrow>\<^sub>h h'3" and
         disc_nodes_document_ptr_h3: "h'3 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes_document_ptr_h'3" and
         h2': "h'3 \<turnstile> set_disconnected_nodes owner_document (node # disc_nodes_document_ptr_h'3) \<rightarrow>\<^sub>h h2"
         using h2'
         by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] )
 
       have object_ptr_kinds_h'2_eq3: "object_ptr_kinds h'2 = object_ptr_kinds h'3"
         apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
               OF set_disconnected_nodes_writes h'3])
         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_h'2: "\<And>ptrs. h'2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h'3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
         by(simp add: object_ptr_kinds_M_defs)
       then have object_ptr_kinds_eq_h'2: "|h'2 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> object_ptr_kinds_M|\<^sub>r"
         by(simp)
       then have node_ptr_kinds_eq_h'2: "|h'2 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> node_ptr_kinds_M|\<^sub>r"
         using node_ptr_kinds_M_eq by blast
       then have node_ptr_kinds_eq3_h'2: "node_ptr_kinds h'2 = node_ptr_kinds h'3"
         by auto
       have document_ptr_kinds_eq2_h'2: "|h'2 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> document_ptr_kinds_M|\<^sub>r"
         using object_ptr_kinds_eq_h'2 document_ptr_kinds_M_eq by auto
       then have document_ptr_kinds_eq3_h'2: "document_ptr_kinds h'2 = document_ptr_kinds h'3"
         using object_ptr_kinds_eq_h'2 document_ptr_kinds_M_eq by auto
       have children_eq_h'2: "\<And>ptr children. h'2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children = h'3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
         using get_child_nodes_reads set_disconnected_nodes_writes h'3
         apply(rule reads_writes_preserved)
         by (simp add: set_disconnected_nodes_get_child_nodes)
       then have children_eq2_h'2: "\<And>ptr. |h'2 \<turnstile> get_child_nodes ptr|\<^sub>r = |h'3 \<turnstile> get_child_nodes ptr|\<^sub>r"
         using select_result_eq by force
 
       have object_ptr_kinds_h'3_eq3: "object_ptr_kinds h'3 = object_ptr_kinds h2"
         apply(rule writes_small_big[where P="\<lambda>h h2. object_ptr_kinds h = object_ptr_kinds h2",
               OF set_disconnected_nodes_writes h2'])
         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_h'3: "\<And>ptrs. h'3 \<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_eq_h'3: "|h'3 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
         by(simp)
       then have node_ptr_kinds_eq_h'3: "|h'3 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> node_ptr_kinds_M|\<^sub>r"
         using node_ptr_kinds_M_eq by blast
       then have node_ptr_kinds_eq3_h'3: "node_ptr_kinds h'3 = node_ptr_kinds h2"
         by auto
       have document_ptr_kinds_eq2_h'3: "|h'3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> document_ptr_kinds_M|\<^sub>r"
         using object_ptr_kinds_eq_h'3 document_ptr_kinds_M_eq by auto
       then have document_ptr_kinds_eq3_h'3: "document_ptr_kinds h'3 = document_ptr_kinds h2"
         using object_ptr_kinds_eq_h'3 document_ptr_kinds_M_eq by auto
       have children_eq_h'3: "\<And>ptr children. h'3 \<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_disconnected_nodes_writes h2'
         apply(rule reads_writes_preserved)
         by (simp add: set_disconnected_nodes_get_child_nodes)
       then have children_eq2_h'3: "\<And>ptr. |h'3 \<turnstile> get_child_nodes ptr|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr|\<^sub>r"
         using select_result_eq by force
 
       show ?thesis
         by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_h'2_eq3 object_ptr_kinds_h'3_eq3
             children_eq2_h'3 children_eq2_h'2)
     qed
     ultimately
     show ?thesis
       by simp
   qed
 
   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 "a_ptr_disconnected_node_rel h3 \<subseteq> a_ptr_disconnected_node_rel h"
   proof -
     have "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast owner_document, cast node)}"
       apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2)[1]
          apply(case_tac "aa = owner_document")
       using disconnected_nodes_h2 disconnected_nodes_h3 notin_set_remove1 apply fastforce
       using disconnected_nodes_eq2_h2 apply auto[1]
       using node_not_in_disconnected_nodes apply blast
        apply(case_tac "aa = owner_document")
       using disconnected_nodes_h2 disconnected_nodes_h3 notin_set_remove1 apply fastforce
       using disconnected_nodes_eq2_h2 apply auto[1]
       apply(case_tac "aa = owner_document")
       using disconnected_nodes_h2 disconnected_nodes_h3 notin_set_remove1 apply fastforce
       using disconnected_nodes_eq2_h2 apply auto[1]
       done
     then have "a_ptr_disconnected_node_rel h'2 \<subseteq> a_ptr_disconnected_node_rel h \<union> {(cast old_document, cast node)}"
       using h'2 parent_opt
     proof (induct parent_opt)
       case None
       then show ?case
         by auto
     next
       case (Some parent)
       then
       have h'2: "h \<turnstile> remove_child parent node \<rightarrow>\<^sub>h h'2"
         by auto
       then
       have "parent |\<in>| object_ptr_kinds h"
         using CD.remove_child_ptr_in_heap
         by blast
       obtain children_h h''2 disconnected_nodes_h where
         owner_document: "h \<turnstile> get_owner_document (cast node) \<rightarrow>\<^sub>r old_document" and
         children_h: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children_h" and
         child_in_children_h: "node \<in> set children_h" and
         disconnected_nodes_h: "h \<turnstile>  get_disconnected_nodes old_document \<rightarrow>\<^sub>r disconnected_nodes_h" and
         h''2: "h \<turnstile>  set_disconnected_nodes old_document (node # disconnected_nodes_h) \<rightarrow>\<^sub>h h''2" and
         h'2: "h''2 \<turnstile> set_child_nodes parent (remove1 node children_h) \<rightarrow>\<^sub>h h'2"
         using h'2 old_document
         apply(auto simp add: CD.remove_child_def elim!: bind_returns_heap_E
             dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure]
             pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1]
         using pure_returns_heap_eq returns_result_eq by fastforce
 
       have disconnected_nodes_eq: "\<And>ptr' disc_nodes. ptr' \<noteq> old_document \<Longrightarrow>
 h \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h''2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
         using local.get_disconnected_nodes_reads set_disconnected_nodes_writes h''2
         apply(rule reads_writes_preserved)
         by (metis local.set_disconnected_nodes_get_disconnected_nodes_different_pointers)
       then
       have disconnected_nodes_eq2: "\<And>ptr'. ptr' \<noteq> old_document \<Longrightarrow>
 |h \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h''2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
         by (meson select_result_eq)
       have "h''2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r node # disconnected_nodes_h"
         using h''2 local.set_disconnected_nodes_get_disconnected_nodes
         by blast
 
       have disconnected_nodes_eq_h2:
         "\<And>ptr' disc_nodes. h''2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h'2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
         using local.get_disconnected_nodes_reads set_child_nodes_writes h'2
         apply(rule reads_writes_preserved)
         by (metis local.set_child_nodes_get_disconnected_nodes)
       then
       have disconnected_nodes_eq2_h2:
         "\<And>ptr'. |h''2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h'2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
         by (meson select_result_eq)
       show ?case
         apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_hx
             \<open>\<And>ptr'. |h''2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h'2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r\<close>[symmetric])[1]
          apply(case_tac "aa = old_document")
         using disconnected_nodes_h
           \<open>h''2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r node # disconnected_nodes_h\<close>
           apply(auto)[1]
          apply(auto dest!: disconnected_nodes_eq2)[1]
         apply(case_tac "aa = old_document")
         using disconnected_nodes_h
           \<open>h''2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r node # disconnected_nodes_h\<close>
          apply(auto)[1]
         apply(auto dest!: disconnected_nodes_eq2)[1]
         done
     qed
     show ?thesis
     proof(cases "owner_document = old_document")
       case True
       then have "a_ptr_disconnected_node_rel h'2 = a_ptr_disconnected_node_rel h2"
         using h2'
         by(auto simp add: a_ptr_disconnected_node_rel_def)
       then
       show ?thesis
         using \<open>a_ptr_disconnected_node_rel h3 =
 a_ptr_disconnected_node_rel h2 - {(cast owner_document, cast node)}\<close>
         using True \<open>local.a_ptr_disconnected_node_rel h'2 \<subseteq> local.a_ptr_disconnected_node_rel h \<union>
 {(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 old_document, 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)}\<close> by auto
     next
       case False
       then obtain h'3 old_disc_nodes disc_nodes_document_ptr_h'3 where
         docs_neq: "owner_document \<noteq> old_document" and
         old_disc_nodes: "h'2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r old_disc_nodes" and
         h'3: "h'2 \<turnstile> set_disconnected_nodes old_document (remove1 node old_disc_nodes) \<rightarrow>\<^sub>h h'3" and
         disc_nodes_document_ptr_h3: "h'3 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes_document_ptr_h'3" and
         h2': "h'3 \<turnstile> set_disconnected_nodes owner_document (node # disc_nodes_document_ptr_h'3) \<rightarrow>\<^sub>h h2"
         using h2'
         by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] )
 
       have object_ptr_kinds_h'2_eq3: "object_ptr_kinds h'2 = object_ptr_kinds h'3"
         apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
               OF set_disconnected_nodes_writes h'3])
         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_h'2:
         "\<And>ptrs. h'2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h'3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
         by(simp add: object_ptr_kinds_M_defs)
       then have object_ptr_kinds_eq_h'2: "|h'2 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> object_ptr_kinds_M|\<^sub>r"
         by(simp)
       then have node_ptr_kinds_eq_h'2: "|h'2 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> node_ptr_kinds_M|\<^sub>r"
         using node_ptr_kinds_M_eq by blast
       then have node_ptr_kinds_eq3_h'2: "node_ptr_kinds h'2 = node_ptr_kinds h'3"
         by auto
       have document_ptr_kinds_eq2_h'2: "|h'2 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h'3 \<turnstile> document_ptr_kinds_M|\<^sub>r"
         using object_ptr_kinds_eq_h'2 document_ptr_kinds_M_eq by auto
       then have document_ptr_kinds_eq3_h'2: "document_ptr_kinds h'2 = document_ptr_kinds h'3"
         using object_ptr_kinds_eq_h'2 document_ptr_kinds_M_eq by auto
 
       have disconnected_nodes_eq: "\<And>ptr' disc_nodes. ptr' \<noteq> old_document \<Longrightarrow>
 h'2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h'3 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
         using local.get_disconnected_nodes_reads set_disconnected_nodes_writes h'3
         apply(rule reads_writes_preserved)
         by (metis local.set_disconnected_nodes_get_disconnected_nodes_different_pointers)
       then
       have disconnected_nodes_eq2: "\<And>ptr'. ptr' \<noteq> old_document \<Longrightarrow>
 |h'2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h'3 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
         by (meson select_result_eq)
       have "h'3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r (remove1 node old_disc_nodes)"
         using h'3 local.set_disconnected_nodes_get_disconnected_nodes
         by blast
 
       have object_ptr_kinds_h'3_eq3: "object_ptr_kinds h'3 = object_ptr_kinds h2"
         apply(rule writes_small_big[where P="\<lambda>h h2. object_ptr_kinds h = object_ptr_kinds h2",
               OF set_disconnected_nodes_writes h2'])
         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_h'3: "\<And>ptrs. h'3 \<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_eq_h'3: "|h'3 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
         by(simp)
       then have node_ptr_kinds_eq_h'3: "|h'3 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> node_ptr_kinds_M|\<^sub>r"
         using node_ptr_kinds_M_eq by blast
       then have node_ptr_kinds_eq3_h'3: "node_ptr_kinds h'3 = node_ptr_kinds h2"
         by auto
       have document_ptr_kinds_eq2_h'3: "|h'3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> document_ptr_kinds_M|\<^sub>r"
         using object_ptr_kinds_eq_h'3 document_ptr_kinds_M_eq by auto
       then have document_ptr_kinds_eq3_h'3: "document_ptr_kinds h'3 = document_ptr_kinds h2"
         using object_ptr_kinds_eq_h'3 document_ptr_kinds_M_eq by auto
       have disc_nodes_eq_h'3:
         "\<And>ptr disc_nodes. h'3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r disc_nodes = h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r disc_nodes"
         using get_child_nodes_reads set_disconnected_nodes_writes h2'
         apply(rule reads_writes_preserved)
         by (simp add: set_disconnected_nodes_get_child_nodes)
       then have disc_nodes_eq2_h'3: "\<And>ptr. |h'3 \<turnstile> get_child_nodes ptr|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr|\<^sub>r"
         using select_result_eq by force
 
       have disconnected_nodes_eq: "\<And>ptr' disc_nodes. ptr' \<noteq> owner_document \<Longrightarrow>
 h'3 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes = h2 \<turnstile> get_disconnected_nodes ptr' \<rightarrow>\<^sub>r disc_nodes"
         using local.get_disconnected_nodes_reads set_disconnected_nodes_writes h2'
         apply(rule reads_writes_preserved)
         by (metis local.set_disconnected_nodes_get_disconnected_nodes_different_pointers)
       then
       have disconnected_nodes_eq2': "\<And>ptr'. ptr' \<noteq> owner_document \<Longrightarrow>
 |h'3 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes ptr'|\<^sub>r"
         by (meson select_result_eq)
       have "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r (node # disc_nodes_document_ptr_h'3)"
         using h2' local.set_disconnected_nodes_get_disconnected_nodes
         by blast
 
       have "a_ptr_disconnected_node_rel h'3 = a_ptr_disconnected_node_rel h'2 - {(cast old_document, cast node)}"
         apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq2_h'2[simplified])[1]
            apply(case_tac "aa = old_document")
         using \<open>h'3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r (remove1 node old_disc_nodes)\<close>
           notin_set_remove1 old_disc_nodes
             apply fastforce
            apply(auto dest!: disconnected_nodes_eq2)[1]
         using \<open>h'3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 node old_disc_nodes\<close> h'3
           local.remove_from_disconnected_nodes_removes old_disc_nodes wellformed_h'2
           apply auto[1]
          defer
          apply(case_tac "aa = old_document")
         using \<open>h'3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r (remove1 node old_disc_nodes)\<close>
           notin_set_remove1 old_disc_nodes
           apply fastforce
          apply(auto dest!: disconnected_nodes_eq2)[1]
         apply(case_tac "aa = old_document")
         using \<open>h'3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r (remove1 node old_disc_nodes)\<close>
           notin_set_remove1 old_disc_nodes
          apply fastforce
         apply(auto dest!: disconnected_nodes_eq2)[1]
         done
       moreover
       have "a_ptr_disconnected_node_rel h2 = a_ptr_disconnected_node_rel h'3 \<union>
 {(cast owner_document, cast node)}"
         apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq2_h'3[simplified])[1]
            apply(case_tac "aa = owner_document")
             apply(simp)
            apply(auto dest!: disconnected_nodes_eq2')[1]
           apply(case_tac "aa = owner_document")
         using \<open>h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r node # disc_nodes_document_ptr_h'3\<close>
           disc_nodes_document_ptr_h3 apply auto[1]
           apply(auto dest!: disconnected_nodes_eq2')[1]
         using \<open>node \<in> set disconnected_nodes_h2\<close> disconnected_nodes_h2 local.a_ptr_disconnected_node_rel_def
           local.a_ptr_disconnected_node_rel_disconnected_node apply blast
         defer
         apply(case_tac "aa = owner_document")
         using \<open>h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r node # disc_nodes_document_ptr_h'3\<close>
           disc_nodes_document_ptr_h3 apply auto[1]
         apply(auto dest!: disconnected_nodes_eq2')[1]
         done
       ultimately show ?thesis
         using \<open>a_ptr_disconnected_node_rel h3 =
 a_ptr_disconnected_node_rel h2 - {(cast owner_document, cast node)}\<close>
         using \<open>a_ptr_disconnected_node_rel h'2 \<subseteq>
 a_ptr_disconnected_node_rel h \<union> {(cast old_document, cast node)}\<close>
         by blast
     qed
   qed
 
   have "(cast node, ptr) \<notin> (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_rel h)\<^sup>*"
     using h2
     apply(auto simp add: adopt_node_def elim!: bind_returns_heap_E2 split: if_splits)[1]
     using ancestors assms(1) assms(2) assms(3) local.get_ancestors_di_parent_child_a_host_shadow_root_rel node_not_in_ancestors
     by blast
   then
   have "(cast node, ptr) \<notin> (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*"
     apply(simp add: \<open>a_host_shadow_root_rel h = a_host_shadow_root_rel h2\<close> \<open>a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3\<close>)
     apply(simp add: \<open>parent_child_rel h2 = parent_child_rel h3\<close>[symmetric])
     using \<open>parent_child_rel h2 \<subseteq> parent_child_rel h\<close> \<open>a_ptr_disconnected_node_rel h3 \<subseteq> a_ptr_disconnected_node_rel h\<close>
     by (smt Un_assoc in_rtrancl_UnI sup.orderE sup_left_commute)
 
   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 h3)\<^sup>*}"
       by (meson \<open>(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) \<notin> (parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3 \<union>
 local.a_ptr_disconnected_node_rel h3)\<^sup>*\<close> in_rtrancl_UnI mem_Collect_eq)
     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]
        apply (metis \<open>known_ptrs h3\<close> \<open>type_wf h3\<close> children_eq_h2
           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_commutes
           object_ptr_kinds_eq_h2 returns_result_select_result wellformed_h2)
       by (metis (mono_tags, opaque_lifting) disconnected_nodes_eq2_h2 disconnected_nodes_h2
           disconnected_nodes_h3 document_ptr_kinds_eq_h2 node_ptr_kinds_commutes
           object_ptr_kinds_eq_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 children_eq_h2 local.heap_is_wellformed_children_in_heap node_ptr_kinds_eq2_h2
         node_ptr_kinds_eq2_h3 wellformed_h2 by auto
     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, opaque_lifting) contra_subsetD 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]
        apply (metis (no_types, lifting) children_eq2_h3 children_h' select_result_I2 subsetD)
       by (metis (no_types, lifting) disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 in_mono)
   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 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, opaque_lifting) 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, opaque_lifting) 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 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, opaque_lifting) "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, opaque_lifting) "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]
     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 (smt 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 in_set_remove1
         object_ptr_kinds_eq_h3 ptr_in_heap select_result_I2)
 
   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 "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast owner_document, cast node)}"
     apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2 disconnected_nodes_eq2_h2)[1]
       apply(case_tac "aa = owner_document")
        apply (metis (no_types, lifting) case_prodI disconnected_nodes_h2 disconnected_nodes_h3
         in_set_remove1 mem_Collect_eq node_not_in_disconnected_nodes pair_imageI select_result_I2)
     using disconnected_nodes_eq2_h2 apply auto[1]
     using node_not_in_disconnected_nodes apply blast
     by (metis (no_types, lifting) case_prodI disconnected_nodes_eq2_h2 disconnected_nodes_h2
         disconnected_nodes_h3 in_set_remove1 mem_Collect_eq pair_imageI select_result_I2)
   have "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h'"
     by(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h3 disconnected_nodes_eq2_h3)
 
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)"
     using \<open>heap_is_wellformed h2\<close>
     by(auto simp add: \<open>a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h2 - {(cast owner_document, cast node)}\<close>
         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> elim!: acyclic_subset)
   then
   have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> local.a_ptr_disconnected_node_rel h')"
     using \<open>(cast node, ptr) \<notin> (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*\<close>
     by(auto simp add: \<open>a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h'\<close> \<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>)
   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_di get_ancestors_di_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 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_parent
   get_parent_locs adopt_node adopt_node_locs get_owner_document insert_before insert_before_locs append_child
   known_ptrs remove_child remove_child_locs get_ancestors_di get_ancestors_di_locs adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   adopt_node_locs\<^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 heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   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>
 
 locale l_append_child_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma append_child_heap_is_wellformed_preserved:
   assumes wellformed: "heap_is_wellformed h"
     and append_child: "h \<turnstile> append_child ptr node \<rightarrow>\<^sub>h h'"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "heap_is_wellformed h'" and "type_wf h'" and "known_ptrs h'"
   using assms
   by(auto simp add: append_child_def intro: insert_before_child_preserves)
 
 lemma append_child_children:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs"
   assumes "h \<turnstile> append_child ptr node \<rightarrow>\<^sub>h h'"
   assumes "node \<notin> set xs"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs @ [node]"
 proof -
 
   obtain ancestors owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors_di ptr \<rightarrow>\<^sub>r ancestors" and
     node_not_in_ancestors: "cast node \<notin> set ancestors" 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 None \<rightarrow>\<^sub>h h'"
     using assms(5)
     by(auto simp add: append_child_def 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 "\<And>parent. |h \<turnstile> get_parent node|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr"
     using assms(1) assms(4) assms(6)
     by (metis (no_types, lifting) assms(2) assms(3) h2 is_OK_returns_heap_I is_OK_returns_result_E
         local.adopt_node_child_in_heap local.get_parent_child_dual local.get_parent_ok
         select_result_I2)
   have "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs"
     using get_child_nodes_reads adopt_node_writes h2 assms(4)
     apply(rule reads_writes_separate_forwards)
     using \<open>\<And>parent. |h \<turnstile> get_parent node|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>
     apply(auto simp add: adopt_node_locs_def CD.adopt_node_locs_def CD.remove_child_locs_def)[1]
     by (meson local.set_child_nodes_get_child_nodes_different_pointers)
 
   have "h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs"
     using get_child_nodes_reads set_disconnected_nodes_writes h3 \<open>h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs\<close>
     apply(rule reads_writes_separate_forwards)
     by(auto)
 
   have "ptr |\<in>| object_ptr_kinds h"
     by (meson ancestors is_OK_returns_result_I local.get_ancestors_ptr_in_heap)
   then
   have "known_ptr ptr"
     using assms(3)
     using local.known_ptrs_known_ptr by blast
 
   have "type_wf h2"
     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  \<open>type_wf h\<close>
     by(auto simp add: adopt_node_locs_def remove_child_locs_def reflp_def transp_def split: if_splits)
   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)
 
   show "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs@[node]"
     using h'
     apply(auto simp add: a_insert_node_def
         dest!: bind_returns_heap_E3[rotated, OF \<open>h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs\<close>
           get_child_nodes_pure, rotated])[1]
     using \<open>type_wf h3\<close> set_child_nodes_get_child_nodes \<open>known_ptr ptr\<close>
     by metis
 qed
 
 lemma append_child_for_all_on_children:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs"
   assumes "h \<turnstile> forall_M (append_child ptr) nodes \<rightarrow>\<^sub>h h'"
   assumes "set nodes \<inter> set xs = {}"
   assumes "distinct nodes"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs@nodes"
   using assms
   apply(induct nodes arbitrary: h xs)
    apply(simp)
 proof(auto elim!: bind_returns_heap_E)[1]fix a nodes h xs h'a
   assume 0: "(\<And>h xs. heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
               \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs \<Longrightarrow> h \<turnstile> forall_M (append_child ptr) nodes \<rightarrow>\<^sub>h h'
               \<Longrightarrow> set nodes \<inter> set xs = {} \<Longrightarrow> h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs @ nodes)"
     and 1: "heap_is_wellformed h"
     and 2: "type_wf h"
     and 3: "known_ptrs h"
     and 4: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs"
     and 5: "h \<turnstile> append_child ptr a \<rightarrow>\<^sub>r ()"
     and 6: "h \<turnstile> append_child ptr a \<rightarrow>\<^sub>h h'a"
     and 7: "h'a \<turnstile> forall_M (append_child ptr) nodes \<rightarrow>\<^sub>h h'"
     and 8: "a \<notin> set xs"
     and 9: "set nodes \<inter> set xs = {}"
     and 10: "a \<notin> set nodes"
     and 11: "distinct nodes"
   then have "h'a \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs @ [a]"
     using append_child_children 6
     using "1" "2" "3" "4" "8" by blast
 
   moreover have "heap_is_wellformed h'a" and "type_wf h'a" and "known_ptrs h'a"
     using insert_before_child_preserves 1 2 3 6 append_child_def
     by metis+
   moreover have "set nodes \<inter> set (xs @ [a]) = {}"
     using 9 10
     by auto
   ultimately show "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r xs @ a # nodes"
     using 0 7
     by fastforce
 qed
 
 
 lemma append_child_for_all_on_no_children:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
   assumes "h \<turnstile> forall_M (append_child ptr) nodes \<rightarrow>\<^sub>h h'"
   assumes "distinct nodes"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r nodes"
   using assms append_child_for_all_on_children
   by force
 end
 
 interpretation i_append_child_wf?: l_append_child_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 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_parent get_parent_locs adopt_node adopt_node_locs get_owner_document insert_before
   insert_before_locs append_child known_ptrs remove_child remove_child_locs get_ancestors_di
   get_ancestors_di_locs adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M adopt_node_locs\<^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 heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   by(auto simp add: l_append_child_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_append_child_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^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_get_disconnected_document_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"
 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, opaque_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 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 (verit) 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 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_remove)
       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 (verit) 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 h'
           set_disconnected_nodes_get_disconnected_nodes
           CD.a_all_ptrs_in_heap_def
           select_result_I2 set_ConsD subsetD)
       by (smt (verit) 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 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, opaque_lifting) "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, opaque_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 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 document_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 document_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 document_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 (verit) Diff_empty Diff_insert0 ElementMonad.ptr_kinds_M_ptr_kinds
         ElementMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) 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 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 (verit) \<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 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 (z3) \<open>type_wf h3\<close> 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]
     apply (metis (no_types, lifting) Collect_cong assms(3) case_prodE case_prodI h2 host_shadow_root_rel_def
         i_get_parent_get_host_get_disconnected_document_wf.a_host_shadow_root_rel_shadow_root
         local.a_host_shadow_root_rel_def local.get_shadow_root_impl local.get_shadow_root_ok new_element_ptr
         new_element_ptr_not_in_heap returns_result_select_result select_result_I2 shadow_root_eq_h)
     done
   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 \<open>type_wf h2\<close> case_prodE case_prodI element_ptr_kinds_eq_h2 host_shadow_root_rel_def
         i_get_root_node_si_wf.a_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)
     by (metis (no_types, lifting) Collect_cong \<open>type_wf h3\<close> case_prodI2 case_prod_conv element_ptr_kinds_eq_h2
         host_shadow_root_rel_def i_get_root_node_si_wf.a_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)
   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 (smt Collect_cong Shadow_DOM.a_host_shadow_root_rel_def \<open>type_wf h3\<close> case_prodD case_prodI2
         element_ptr_kinds_eq_h2 i_get_root_node_si_wf.a_host_shadow_root_rel_shadow_root 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> case_prodE case_prodI element_ptr_kinds_eq_h2 host_shadow_root_rel_def
         i_get_root_node_si_wf.a_host_shadow_root_rel_shadow_root l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_host_shadow_root_rel_def
         local.get_shadow_root_impl local.get_shadow_root_ok returns_result_select_result shadow_root_eq_h3)
     done
 
 
   have "a_ptr_disconnected_node_rel h = a_ptr_disconnected_node_rel h2"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h disconnected_nodes_eq2_h)
   have "a_ptr_disconnected_node_rel h2 = a_ptr_disconnected_node_rel h3"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2 disconnected_nodes_eq2_h2)
 
   have "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_element_ptr # disc_nodes_h3"
     using h' local.set_disconnected_nodes_get_disconnected_nodes by auto
   have " document_ptr |\<in>| document_ptr_kinds h3"
     by (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close> document_ptr_kinds_eq_h document_ptr_kinds_eq_h2)
   have "cast new_element_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r 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 # disc_nodes_h3\<close>
     by auto
 
   have "a_ptr_disconnected_node_rel h' = {(cast document_ptr, cast new_element_ptr)} \<union> a_ptr_disconnected_node_rel h3"
     apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h3 disconnected_nodes_eq2_h3)[1]
       apply(case_tac "aa = document_ptr")
     using disc_nodes_h3 h' \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_element_ptr # disc_nodes_h3\<close>
        apply(auto)[1]
     using disconnected_nodes_eq2_h3 apply auto[1]
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_element_ptr # disc_nodes_h3\<close>
     using \<open>cast new_element_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r\<close>
     using \<open>document_ptr |\<in>| document_ptr_kinds h3\<close> apply auto[1]
     apply(case_tac "document_ptr = aa")
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r 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 # disc_nodes_h3\<close> disc_nodes_h3
      apply auto[1]
     using disconnected_nodes_eq_h3[THEN select_result_eq, simplified] by auto
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2 \<union> a_ptr_disconnected_node_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>local.a_ptr_disconnected_node_rel h = local.a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>local.a_ptr_disconnected_node_rel h2 = local.a_ptr_disconnected_node_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' \<union> a_ptr_disconnected_node_rel h' =
 {(cast document_ptr, cast new_element_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3"
     by (simp add: \<open>local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'\<close>
         \<open>local.a_ptr_disconnected_node_rel h' = {(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 document_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 new_element_ptr)} \<union>
 local.a_ptr_disconnected_node_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_element_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> element_ptr_kinds_commutes h2 new_element_ptr
       new_element_ptr_not_in_heap node_ptr_kinds_commutes
     by blast
   moreover
   have "\<And>a b. (a, b) \<in> a_host_shadow_root_rel h3 \<Longrightarrow> a \<noteq> cast new_element_ptr"
     using shadow_root_eq_h2 shadow_root_none
     by(auto simp add: a_host_shadow_root_rel_def)
   moreover
   have "\<And>a b. (a, b) \<in> a_ptr_disconnected_node_rel h3 \<Longrightarrow> a \<noteq> cast new_element_ptr"
     by(auto simp add: a_ptr_disconnected_node_rel_def)
   moreover
   have "cast new_element_ptr \<notin> {x. (x, cast document_ptr) \<in>
 (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*}"
     by (smt Un_iff \<open>\<And>b a. (a, b) \<in> local.a_host_shadow_root_rel h3 \<Longrightarrow>
 a \<noteq> 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\<close> \<open>\<And>b a. (a, b) \<in> local.a_ptr_disconnected_node_rel h3 \<Longrightarrow>
 a \<noteq> 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\<close> \<open>\<And>b a. (a, b) \<in> parent_child_rel h3 \<Longrightarrow>
 a \<noteq> 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\<close> cast_document_ptr_not_node_ptr(1) converse_rtranclE mem_Collect_eq)
   moreover
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2\<close>
       \<open>parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3 \<union> local.a_ptr_disconnected_node_rel h3\<close>
     by auto
   ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h' =
 {(cast document_ptr, cast new_element_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3\<close>)
 
 
   show " heap_is_wellformed h' "
     using \<open>acyclic (parent_child_rel h' \<union> local.a_host_shadow_root_rel h' \<union> local.a_ptr_disconnected_node_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, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M \<open>parent_child_rel h = parent_child_rel h2\<close>
         children_eq2_h 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, opaque_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 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 (verit) 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 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_remove)
       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, opaque_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>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 (verit) 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 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, opaque_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 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 document_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 document_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 document_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 "a_ptr_disconnected_node_rel h = a_ptr_disconnected_node_rel h2"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h disconnected_nodes_eq2_h)
   have "a_ptr_disconnected_node_rel h2 = a_ptr_disconnected_node_rel h3"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2 disconnected_nodes_eq2_h2)
 
   have "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3"
     using h' local.set_disconnected_nodes_get_disconnected_nodes by auto
   have " document_ptr |\<in>| document_ptr_kinds h3"
     by (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close> document_ptr_kinds_eq_h document_ptr_kinds_eq_h2)
   have "cast new_character_data_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3\<close> by auto
 
   have "a_ptr_disconnected_node_rel h' = {(cast document_ptr, cast new_character_data_ptr)} \<union> a_ptr_disconnected_node_rel h3"
     apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h3 disconnected_nodes_eq2_h3)[1]
       apply(case_tac "aa = document_ptr")
     using disc_nodes_h3 h' \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3\<close>
        apply(auto)[1]
     using disconnected_nodes_eq2_h3 apply auto[1]
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3\<close>
     using \<open>cast new_character_data_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r\<close>
     using \<open>document_ptr |\<in>| document_ptr_kinds h3\<close> apply auto[1]
     apply(case_tac "document_ptr = aa")
     using \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3\<close> disc_nodes_h3 apply auto[1]
     using disconnected_nodes_eq_h3[THEN select_result_eq, simplified] by auto
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2 \<union> a_ptr_disconnected_node_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>local.a_ptr_disconnected_node_rel h = local.a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>local.a_ptr_disconnected_node_rel h2 = local.a_ptr_disconnected_node_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' \<union> a_ptr_disconnected_node_rel h' =
 {(cast document_ptr, cast new_character_data_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3"
     by (simp add: \<open>local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'\<close>
         \<open>local.a_ptr_disconnected_node_rel h' = {(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 document_ptr, cast new_character_data_ptr)} \<union>
 local.a_ptr_disconnected_node_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_character_data_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> character_data_ptr_kinds_commutes h2 new_character_data_ptr
       new_character_data_ptr_not_in_heap node_ptr_kinds_commutes by blast
   moreover
   have "\<And>a b. (a, b) \<in> a_host_shadow_root_rel h3 \<Longrightarrow> a \<noteq> cast new_character_data_ptr"
     using shadow_root_eq_h2
     by(auto simp add: a_host_shadow_root_rel_def)
   moreover
   have "\<And>a b. (a, b) \<in> a_ptr_disconnected_node_rel h3 \<Longrightarrow> a \<noteq> cast new_character_data_ptr"
     by(auto simp add: a_ptr_disconnected_node_rel_def)
   moreover
   have "cast new_character_data_ptr \<notin> {x. (x, cast document_ptr) \<in>
 (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*}"
     by (smt Un_iff calculation(1) calculation(2) calculation(3) cast_document_ptr_not_node_ptr(2)
         converse_rtranclE mem_Collect_eq)
   moreover
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2\<close>
       \<open>parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3 \<union> local.a_ptr_disconnected_node_rel h3\<close>
     by auto
   ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h' =
 {(cast document_ptr, cast new_character_data_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_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' \<union> local.a_ptr_disconnected_node_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
     by (auto simp add: document_ptr_kinds_def)
 
 
   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, opaque_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 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_remove)
 
          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 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_def 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_def select_result_eq[OF shadow_root_eq_h] select_result_eq[OF tag_name_eq_h]
         is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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>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)
 
 
   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 "a_ptr_disconnected_node_rel h = a_ptr_disconnected_node_rel h'"
     apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h disconnected_nodes_eq2_h)[1]
     using \<open>new_document_ptr |\<notin>| document_ptr_kinds h\<close> disconnected_nodes_eq2_h apply fastforce
     using new_document_disconnected_nodes[OF h' new_document_ptr]
      apply(simp add: CD.get_disconnected_nodes_impl CD.a_get_disconnected_nodes_def)
     using \<open>new_document_ptr |\<notin>| document_ptr_kinds h\<close> disconnected_nodes_eq2_h apply fastforce
     done
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h =
 parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h'"
     by (simp add: \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h'\<close>
         \<open>local.a_ptr_disconnected_node_rel h = local.a_ptr_disconnected_node_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' \<union> a_ptr_disconnected_node_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' \<union>
 local.a_ptr_disconnected_node_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> document_ptr_kinds_M|\<^sub>r"
     by simp
   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 |\<union>| {|cast new_shadow_root_ptr|}"
     apply(simp add: document_ptr_kinds_def)
     by force
   then have shadow_root_ptr_kinds_eq_h:
     "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h |\<union>| {|new_shadow_root_ptr|}"
     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)
   then have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds 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)
   then have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds 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 document_ptr_kinds_eq_h: "document_ptr_kinds h2 = document_ptr_kinds h |\<union>| {|cast new_shadow_root_ptr|}"
     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_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. doc_ptr \<noteq> cast new_shadow_root_ptr
                 \<Longrightarrow> 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_different_pointers[rotated, OF new_shadow_root_ptr h2]
     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. doc_ptr \<noteq> cast new_shadow_root_ptr
                 \<Longrightarrow> |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 "h2 \<turnstile> get_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
     using h2 new_shadow_root_no_disconnected_nodes new_shadow_root_ptr by auto
 
   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 (no_types, opaque_lifting) \<open>h2 \<turnstile> get_disconnected_nodes (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
         \<open>type_wf h2\<close> disconnected_nodes_eq_h empty_iff is_OK_returns_result_E is_OK_returns_result_I
         local.get_disconnected_nodes_ok local.get_disconnected_nodes_ptr_in_heap node_ptr_kinds_eq_h select_result_I2
         set_empty 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 (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 "cast new_shadow_root_ptr |\<notin>| document_ptr_kinds h"
     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_not_in_heap new_shadow_root_ptr shadow_root_ptr_kinds_commutes by blast
 
   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_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
       \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
 
     apply(auto simp add: children_eq2_h[symmetric] 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)[1]
           apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert_remove)
 
          apply(auto simp add:  dest: distinct_concat_map_E)[1]
         apply(auto simp add:  dest: distinct_concat_map_E)[1]
     using \<open>cast new_shadow_root_ptr |\<notin>| document_ptr_kinds h\<close>
        apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1]
 
       apply (metis (no_types) DocumentMonad.ptr_kinds_M_ptr_kinds DocumentMonad.ptr_kinds_ptr_kinds_M
         concat_map_all_distinct disconnected_nodes_eq2_h select_result_I2)
   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> cast new_shadow_root_ptr"
     assume a4: "y |\<in>| document_ptr_kinds h"
     assume a5: "y \<noteq> cast new_shadow_root_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 |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r"
     assume a8: "xa \<in> set |h2 \<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 (simp add: disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)
     have f10: "xa \<in> set |h \<turnstile> get_disconnected_nodes y|\<^sub>r"
       using a8 a5 disconnected_nodes_eq2_h
       by (simp add: disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)
     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: "h2 \<turnstile> get_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
       and 1: "h2 \<turnstile> get_child_nodes (cast new_shadow_root_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 |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       and 7: "xa |\<in>| object_ptr_kinds h"
       and 8: "xa \<noteq> cast new_shadow_root_ptr"
       and 9: "xb |\<in>| document_ptr_kinds h"
       and 10: "xb \<noteq> cast new_shadow_root_ptr"
     then show "False"
       by (metis CD.distinct_lists_no_parent \<open>local.CD.a_distinct_lists h\<close> assms(2) disconnected_nodes_eq2_h
           local.get_disconnected_nodes_ok returns_result_select_result)
   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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr |\<notin>| document_ptr_kinds h\<close> assms(2) assms(3) children_eq2_h
         children_eq_h disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
         document_ptr_kinds_commutes is_OK_returns_result_I local.known_ptrs_known_ptr
         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>
         by (auto simp add: shadow_root_ptr_kinds_eq_h3 shadow_root_ptr_kinds_eq_h2 shadow_root_ptr_kinds_eq_h)
       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 (verit) \<open>type_wf h'\<close> assms(2) 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
         i_get_parent_get_host_get_disconnected_document_wf.a_host_shadow_root_rel_shadow_root 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
     apply (smt 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
         i_get_root_node_si_wf.a_host_shadow_root_rel_shadow_root image_iff local.get_shadow_root_impl
         local.get_shadow_root_ok mem_Collect_eq option.distinct(1) prev_shadow_root returns_result_eq
         returns_result_select_result shadow_root_eq_h shadow_root_eq_h2)
     done
 
   have "a_ptr_disconnected_node_rel h = a_ptr_disconnected_node_rel h2"
     apply(auto simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h)[1]
       apply (metis (no_types, lifting) \<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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr |\<notin>| document_ptr_kinds h\<close>
         case_prodI disconnected_nodes_eq2_h mem_Collect_eq pair_imageI)
     using \<open>h2 \<turnstile> get_disconnected_nodes (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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
      apply auto[1]
     apply(case_tac "cast new_shadow_root_ptr \<noteq> aa")
      apply (simp add: disconnected_nodes_eq2_h image_iff)
     using \<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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr |\<notin>| document_ptr_kinds h\<close>
     apply blast
     done
   have "a_ptr_disconnected_node_rel h2 = a_ptr_disconnected_node_rel h3"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h2 disconnected_nodes_eq2_h2)
   have "a_ptr_disconnected_node_rel h3 = a_ptr_disconnected_node_rel h'"
     by(simp add: a_ptr_disconnected_node_rel_def document_ptr_kinds_eq_h3 disconnected_nodes_eq2_h3)
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h \<union> a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2 \<union> a_ptr_disconnected_node_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>local.a_ptr_disconnected_node_rel h = local.a_ptr_disconnected_node_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 \<union> a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>local.a_ptr_disconnected_node_rel h2 = local.a_ptr_disconnected_node_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' \<union> a_ptr_disconnected_node_rel h' =
 {(cast element_ptr, cast new_shadow_root_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_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>local.a_ptr_disconnected_node_rel h3 = local.a_ptr_disconnected_node_rel h'\<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>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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr |\<notin>| document_ptr_kinds h\<close>
       \<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 blast
   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 "\<And>a b. (a, b) \<in> a_ptr_disconnected_node_rel h3 \<Longrightarrow> a \<noteq> cast new_shadow_root_ptr"
     using \<open>h2 \<turnstile> get_disconnected_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
     by(auto simp add: a_ptr_disconnected_node_rel_def disconnected_nodes_eq_h2)
   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 \<union> a_ptr_disconnected_node_rel h3)\<^sup>*}"
     by (smt Un_iff calculation(1) calculation(2) calculation(3) cast_document_ptr_not_node_ptr(2) converse_rtranclE mem_Collect_eq)
   moreover
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h \<union> local.a_ptr_disconnected_node_rel h =
 parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2\<close>
       \<open>parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 \<union> local.a_ptr_disconnected_node_rel h2 =
 parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3 \<union> local.a_ptr_disconnected_node_rel h3\<close> by auto
   ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' \<union> a_ptr_disconnected_node_rel h' =
 {(cast element_ptr, cast new_shadow_root_ptr)} \<union>
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3 \<union> a_ptr_disconnected_node_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' \<union> local.a_ptr_disconnected_node_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