diff --git a/thys/Core_DOM/standard/Core_DOM_Heap_WF.thy b/thys/Core_DOM/standard/Core_DOM_Heap_WF.thy
--- a/thys/Core_DOM/standard/Core_DOM_Heap_WF.thy
+++ b/thys/Core_DOM/standard/Core_DOM_Heap_WF.thy
@@ -1,8045 +1,8045 @@
 (***********************************************************************************
  * Copyright (c) 2016-2018 The University of Sheffield, 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>Wellformedness\<close>
 text\<open>In this theory, we discuss the wellformedness of the DOM. First, we define
 wellformedness and, second, we show for all functions for querying and modifying the
 DOM to what extend they preserve wellformendess.\<close>
 
 theory Core_DOM_Heap_WF
   imports
     "Core_DOM_Functions"
 begin
 
 locale l_heap_is_wellformed\<^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_disconnected_nodes_defs get_disconnected_nodes get_disconnected_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"
 begin
 definition a_owner_document_valid :: "(_) heap \<Rightarrow> bool"
   where
     "a_owner_document_valid h \<longleftrightarrow> (\<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 h
             \<and> node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)))"
 
 lemma a_owner_document_valid_code [code]: "a_owner_document_valid h \<longleftrightarrow> node_ptr_kinds h |\<subseteq>|
   fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)) @ map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))
 "
   apply(auto simp add: a_owner_document_valid_def
       l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_owner_document_valid_def)[1]
 proof -
   fix x
   assume 1: " \<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 h \<and>
 node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
   assume 2: "x |\<in>| node_ptr_kinds h"
   assume 3: "x |\<notin>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
   have "\<not>(\<exists>document_ptr. document_ptr |\<in>| document_ptr_kinds h \<and>
 x \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)"
     using 1 2 3
     by (smt UN_I fset_of_list_elem image_eqI notin_fset set_concat set_map sorted_list_of_fset_simps(1))
   then
   have "(\<exists>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<and> x \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
     using 1 2
     by auto
   then obtain parent_ptr where parent_ptr:
     "parent_ptr |\<in>| object_ptr_kinds h \<and> x \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
     by auto
   moreover have "parent_ptr \<in> set (sorted_list_of_fset (object_ptr_kinds h))"
     using parent_ptr by auto
   moreover have "|h \<turnstile> get_child_nodes parent_ptr|\<^sub>r \<in> set (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))"
     using calculation(2) by auto
   ultimately
   show "x |\<in>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h))))"
     using fset_of_list_elem by fastforce
 next
   fix node_ptr
   assume 1: "node_ptr_kinds h |\<subseteq>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))) |\<union>|
 fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
   assume 2: "node_ptr |\<in>| node_ptr_kinds h"
   assume 3: "\<forall>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<longrightarrow>
 node_ptr \<notin> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
   have "node_ptr \<in> set (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))) \<or>
 node_ptr \<in> set (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
     using 1 2
     by (meson fin_mono fset_of_list_elem funion_iff)
   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 3
     by auto
 qed
 
 definition a_parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   where
     "a_parent_child_rel h = {(parent, child). parent |\<in>| object_ptr_kinds h
                             \<and> child \<in> cast ` set |h \<turnstile> get_child_nodes parent|\<^sub>r}"
 
 lemma a_parent_child_rel_code [code]: "a_parent_child_rel h = set (concat (map
   (\<lambda>parent. map
     (\<lambda>child. (parent, 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))
     |h \<turnstile> get_child_nodes parent|\<^sub>r)
   (sorted_list_of_fset (object_ptr_kinds h)))
 )"
   by(auto simp add: a_parent_child_rel_def)
 
 definition a_acyclic_heap :: "(_) heap \<Rightarrow> bool"
   where
     "a_acyclic_heap h = acyclic (a_parent_child_rel h)"
 
 definition a_all_ptrs_in_heap :: "(_) heap \<Rightarrow> bool"
   where
     "a_all_ptrs_in_heap h \<longleftrightarrow>
       (\<forall>ptr \<in> fset (object_ptr_kinds h). set |h \<turnstile> get_child_nodes ptr|\<^sub>r \<subseteq> fset (node_ptr_kinds h)) \<and>
       (\<forall>document_ptr \<in> fset (document_ptr_kinds h).
 set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r \<subseteq> fset (node_ptr_kinds h))"
 
 definition a_distinct_lists :: "(_) heap \<Rightarrow> bool"
   where
     "a_distinct_lists h = distinct (concat (
       (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)
    @ (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r)
     ))"
 
 definition a_heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   where
     "a_heap_is_wellformed h \<longleftrightarrow>
       a_acyclic_heap h \<and> a_all_ptrs_in_heap h \<and> a_distinct_lists h \<and> a_owner_document_valid h"
 end
 
 locale l_heap_is_wellformed_defs =
   fixes heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   fixes parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
 
 global_interpretation 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
   defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes
                      get_disconnected_nodes"
     and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes"
     and acyclic_heap = a_acyclic_heap
     and all_ptrs_in_heap = a_all_ptrs_in_heap
     and distinct_lists = a_distinct_lists
     and owner_document_valid = a_owner_document_valid
   .
 
 locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs
   + 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_heap_is_wellformed_defs heap_is_wellformed parent_child_rel
   + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_::linorder) 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 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" +
   assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed"
   assumes parent_child_rel_impl: "parent_child_rel = a_parent_child_rel"
 begin
 lemmas heap_is_wellformed_def = heap_is_wellformed_impl[unfolded a_heap_is_wellformed_def]
 lemmas parent_child_rel_def = parent_child_rel_impl[unfolded a_parent_child_rel_def]
 lemmas acyclic_heap_def = a_acyclic_heap_def[folded parent_child_rel_impl]
 
 lemma parent_child_rel_node_ptr:
   "(parent, child) \<in> parent_child_rel h \<Longrightarrow> is_node_ptr_kind child"
   by(auto simp add: parent_child_rel_def)
 
 lemma parent_child_rel_child_nodes:
   assumes "known_ptr parent"
     and "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     and "child \<in> set children"
   shows "(parent, cast child) \<in> parent_child_rel h"
   using assms
   apply(auto simp add: parent_child_rel_def is_OK_returns_result_I )[1]
   using get_child_nodes_ptr_in_heap by blast
 
 lemma parent_child_rel_child_nodes2:
   assumes "known_ptr parent"
     and "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     and "child \<in> set children"
     and "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 = child_obj"
   shows "(parent, child_obj) \<in> parent_child_rel h"
   using assms parent_child_rel_child_nodes by blast
 
 
 lemma parent_child_rel_finite: "finite (parent_child_rel h)"
 proof -
   have "parent_child_rel h = (\<Union>ptr \<in> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r.
                  (\<Union>child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r. {(ptr, cast child)}))"
     by(auto simp add: parent_child_rel_def)
   moreover have "finite (\<Union>ptr \<in> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r.
                     (\<Union>child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r. {(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 child)}))"
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 lemma distinct_lists_no_parent:
   assumes "a_distinct_lists h"
   assumes "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assumes "node_ptr \<in> set disc_nodes"
   shows "\<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 assms
   apply(auto simp add: a_distinct_lists_def)[1]
 proof -
   fix parent_ptr :: "(_) object_ptr"
   assume a1: "parent_ptr |\<in>| object_ptr_kinds h"
   assume a2: "(\<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) = {}"
   assume a3: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assume a4: "node_ptr \<in> set disc_nodes"
   assume a5: "node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
   have f6: "parent_ptr \<in> fset (object_ptr_kinds h)"
     using a1 by auto
   have f7: "document_ptr \<in> fset (document_ptr_kinds h)"
     using a3 by (meson fmember.rep_eq get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I)
   have "|h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = disc_nodes"
     using a3 by simp
   then show False
     using f7 f6 a5 a4 a2 by blast
 qed
 
 
 lemma distinct_lists_disconnected_nodes:
   assumes "a_distinct_lists h"
     and "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   shows "distinct disc_nodes"
 proof -
   have h1: "distinct (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                              |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
     using assms(1)
     by(simp add: a_distinct_lists_def)
   then show ?thesis
     using concat_map_all_distinct[OF h1] assms(2) is_OK_returns_result_I get_disconnected_nodes_ok
     by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M
         l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap
         l_get_disconnected_nodes_axioms select_result_I2)
 qed
 
 lemma distinct_lists_children:
   assumes "a_distinct_lists h"
     and "known_ptr ptr"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   shows "distinct children"
 proof (cases "children = []", simp)
   assume "children \<noteq> []"
   have h1: "distinct (concat ((map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)))"
     using assms(1)
     by(simp add: a_distinct_lists_def)
   show ?thesis
     using concat_map_all_distinct[OF h1] assms(2) assms(3)
     by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap
         is_OK_returns_result_I select_result_I2)
 qed
 
 lemma heap_is_wellformed_children_in_heap:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   shows "child |\<in>| node_ptr_kinds h"
   using assms
   apply(auto simp add: heap_is_wellformed_def a_all_ptrs_in_heap_def)[1]
   by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I
       local.get_child_nodes_ptr_in_heap select_result_I2 subsetD)
 
 lemma heap_is_wellformed_one_parent:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children'"
   assumes "set children \<inter> set children' \<noteq> {}"
   shows "ptr = ptr'"
   using assms
 proof (auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1]
   fix x :: "(_) node_ptr"
   assume a1: "ptr \<noteq> ptr'"
   assume a2: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assume a3: "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children'"
   assume a4: "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r)
                                      (sorted_list_of_set (fset (object_ptr_kinds h)))))"
   have f5: "|h \<turnstile> get_child_nodes ptr|\<^sub>r = children"
     using a2 by simp
   have "|h \<turnstile> get_child_nodes ptr'|\<^sub>r = children'"
     using a3 by (meson select_result_I2)
   then have "ptr \<notin> set (sorted_list_of_set (fset (object_ptr_kinds h)))
           \<or> ptr' \<notin> set (sorted_list_of_set (fset (object_ptr_kinds h)))
           \<or> set children \<inter> set children' = {}"
     using f5 a4 a1 by (meson distinct_concat_map_E(1))
   then show False
     using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I
         local.get_child_nodes_ptr_in_heap set_sorted_list_of_set)
 qed
 
 lemma parent_child_rel_child:
   "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow>
 child \<in> set children \<longleftrightarrow> (ptr, cast child) \<in> parent_child_rel h"
   by (simp add: is_OK_returns_result_I get_child_nodes_ptr_in_heap parent_child_rel_def)
 
 lemma parent_child_rel_acyclic: "heap_is_wellformed h \<Longrightarrow> acyclic (parent_child_rel h)"
   by (simp add: acyclic_heap_def local.heap_is_wellformed_def)
 
 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 distinct_lists_disconnected_nodes local.heap_is_wellformed_def by blast
 
 lemma parent_child_rel_parent_in_heap:
   "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> parent |\<in>| object_ptr_kinds h"
   using local.parent_child_rel_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"
   apply(auto simp add: heap_is_wellformed_def parent_child_rel_def a_all_ptrs_in_heap_def)[1]
   using get_child_nodes_ok
   by (meson finite_set_in subsetD)
 
 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"
   by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.a_all_ptrs_in_heap_def
       local.get_disconnected_nodes_ptr_in_heap local.heap_is_wellformed_def select_result_I2 subsetD)
 
 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 DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1)
     is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap
     local.heap_is_wellformed_def select_result_I2
 proof -
   assume a1: "heap_is_wellformed h"
   assume a2: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assume a3: "h \<turnstile> get_disconnected_nodes document_ptr' \<rightarrow>\<^sub>r disc_nodes'"
   assume a4: "set disc_nodes \<inter> set disc_nodes' \<noteq> {}"
   have f5: "|h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = disc_nodes"
     using a2 by (meson select_result_I2)
   have f6: "|h \<turnstile> get_disconnected_nodes document_ptr'|\<^sub>r = disc_nodes'"
     using a3 by (meson select_result_I2)
   have "\<And>nss nssa. \<not> distinct (concat (nss @ nssa)) \<or> distinct (concat nssa::(_) node_ptr list)"
     by (metis (no_types) concat_append distinct_append)
   then have "distinct (concat (map (\<lambda>d. |h \<turnstile> get_disconnected_nodes d|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
     using a1 local.a_distinct_lists_def local.heap_is_wellformed_def by blast
   then show ?thesis
     using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1)
         is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap)
 qed
 
 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 = {}"
   by (metis (no_types, opaque_lifting) disjoint_iff_not_equal distinct_lists_no_parent
       is_OK_returns_result_I local.get_child_nodes_ptr_in_heap
       local.heap_is_wellformed_def select_result_I2)
 
 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)"
   apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def a_owner_document_valid_def)[1]
   by (meson fmember.rep_eq)
 lemma heap_is_wellformed_children_distinct:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
   by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append
       distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def
       local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def
       select_result_I2)
 end
 
 locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_get_disconnected_nodes_defs +
   assumes 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"
   assumes 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"
   assumes 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'"
   assumes 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'"
   assumes 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 = {}"
   assumes 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"
   assumes heap_is_wellformed_children_distinct:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
   assumes 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)"
   assumes parent_child_rel_child:
     "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
    \<Longrightarrow> child \<in> set children \<longleftrightarrow> (ptr, cast child) \<in> parent_child_rel h"
   assumes parent_child_rel_finite:
     "heap_is_wellformed h \<Longrightarrow> finite (parent_child_rel h)"
   assumes parent_child_rel_acyclic:
     "heap_is_wellformed h \<Longrightarrow> acyclic (parent_child_rel h)"
   assumes parent_child_rel_node_ptr:
     "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> is_node_ptr_kind child_ptr"
   assumes parent_child_rel_parent_in_heap:
     "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> parent |\<in>| object_ptr_kinds h"
   assumes 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"
 
 interpretation i_heap_is_wellformed?: 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 parent_child_rel
   apply(unfold_locales)
   by(auto simp add: heap_is_wellformed_def parent_child_rel_def)
 declare 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_is_l_heap_is_wellformed [instances]:
   "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes
                         get_disconnected_nodes"
   apply(auto simp add: l_heap_is_wellformed_def)[1]
   using heap_is_wellformed_children_in_heap
                 apply blast
   using heap_is_wellformed_disc_nodes_in_heap
                apply blast
   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 blast
   using heap_is_wellformed_children_distinct
           apply blast
   using heap_is_wellformed_children_disc_nodes
          apply blast
   using parent_child_rel_child
         apply (blast)
   using parent_child_rel_child
        apply(blast)
   using parent_child_rel_finite
       apply blast
   using parent_child_rel_acyclic
      apply blast
   using parent_child_rel_node_ptr
     apply blast
   using parent_child_rel_parent_in_heap
    apply blast
   using parent_child_rel_child_in_heap
   apply blast
   done
 
 subsection \<open>get\_parent\<close>
 
 locale l_get_parent_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
   known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs
   + l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_::linorder) 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 get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_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 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
 lemma child_parent_dual:
   assumes heap_is_wellformed: "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   assumes "known_ptrs h"
   assumes type_wf: "type_wf h"
   shows "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
 proof -
   obtain ptrs where ptrs: "h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by(simp add: object_ptr_kinds_M_defs)
   then have h1: "ptr \<in> set ptrs"
     using get_child_nodes_ok assms(2) is_OK_returns_result_I
     by (metis (no_types, opaque_lifting) ObjectMonad.ptr_kinds_ptr_kinds_M
         \<open>\<And>thesis. (\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
         get_child_nodes_ptr_in_heap returns_result_eq select_result_I2)
 
   let ?P = "(\<lambda>ptr. get_child_nodes ptr \<bind> (\<lambda>children. return (child \<in> set children)))"
   let ?filter = "filter_M ?P ptrs"
 
   have "h \<turnstile> ok ?filter"
     using ptrs type_wf
     using get_child_nodes_ok
     apply(auto intro!: filter_M_is_OK_I bind_is_OK_pure_I get_child_nodes_ok simp add: bind_pure_I)[1]
     using assms(4) local.known_ptrs_known_ptr by blast
   then obtain parent_ptrs where parent_ptrs: "h \<turnstile> ?filter \<rightarrow>\<^sub>r parent_ptrs"
     by auto
 
   have h5: "\<exists>!x. x \<in> set ptrs \<and> h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
     apply(auto intro!: bind_pure_returns_result_I)[1]
     using heap_is_wellformed_one_parent
   proof -
     have "h \<turnstile> (return (child \<in> set children)::((_) heap, exception, bool) prog) \<rightarrow>\<^sub>r True"
       by (simp add: assms(3))
     then show
       "\<exists>z. z \<in> set ptrs \<and> h \<turnstile> Heap_Error_Monad.bind (get_child_nodes z)
                                (\<lambda>ns. return (child \<in> set ns)) \<rightarrow>\<^sub>r True"
       by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I
           local.get_child_nodes_pure select_result_I2)
   next
     fix x y
     assume 0: "x \<in> set ptrs"
       and 1: "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
       and 2: "y \<in> set ptrs"
       and 3: "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes y)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
       and 4: "(\<And>h ptr children ptr' children'. 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')"
     then show "x = y"
       by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed
           return_returns_result)
   qed
 
   have "child |\<in>| node_ptr_kinds h"
     using heap_is_wellformed_children_in_heap heap_is_wellformed assms(2) assms(3)
     by fast
   moreover have "parent_ptrs = [ptr]"
     apply(rule filter_M_ex1[OF parent_ptrs h1 h5])
     using ptrs assms(2) assms(3)
     by(auto simp add: object_ptr_kinds_M_defs bind_pure_I intro!: bind_pure_returns_result_I)
   ultimately  show ?thesis
     using ptrs parent_ptrs
     by(auto simp add: bind_pure_I get_parent_def
         elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *)
 qed
 
 lemma parent_child_rel_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
   shows "(parent, cast child_node) \<in> parent_child_rel h"
   using assms parent_child_rel_child get_parent_child_dual by auto
 
 lemma heap_wellformed_induct [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
     and step: "\<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> P parent"
   shows "P ptr"
 proof -
   fix ptr
   have "wf ((parent_child_rel h)\<inverse>)"
     by (simp add: assms(1) finite_acyclic_wf_converse parent_child_rel_acyclic parent_child_rel_finite)
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less parent)
     then show ?case
       using assms parent_child_rel_child
       by (meson converse_iff)
   qed
 qed
 
 lemma heap_wellformed_induct2 [consumes 3, case_names not_in_heap empty_children step]:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
     and not_in_heap: "\<And>parent. parent |\<notin>| object_ptr_kinds h \<Longrightarrow> P parent"
     and empty_children: "\<And>parent. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r [] \<Longrightarrow> P parent"
     and step: "\<And>parent children child. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children
                \<Longrightarrow> child \<in> set children \<Longrightarrow> P (cast child) \<Longrightarrow> P parent"
   shows "P ptr"
 proof(insert assms(1), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
   proof(cases "parent |\<in>| object_ptr_kinds h")
     case True
     then obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
       using get_child_nodes_ok assms(2) assms(3)
       by (meson is_OK_returns_result_E local.known_ptrs_known_ptr)
     then show ?thesis
     proof (cases "children = []")
       case True
       then show ?thesis
         using children empty_children
         by simp
     next
       case False
       then show ?thesis
         using assms(6) children last_in_set step.hyps by blast
     qed
   next
     case False
     then show ?thesis
       by (simp add: not_in_heap)
   qed
 qed
 
 lemma heap_wellformed_induct_rev [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
     and step: "\<And>child. (\<And>parent child_node. cast child_node = child
                \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent) \<Longrightarrow> P child"
   shows "P ptr"
 proof -
   fix ptr
   have "wf ((parent_child_rel h))"
     by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite
         wf_iff_acyclic_if_finite)
 
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less child)
     show ?case
       using assms get_parent_child_dual
       by (metis less.hyps parent_child_rel_parent)
   qed
 qed
 end
 
 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]
 
 
 locale l_get_parent_wf2\<^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 parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
   + 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 parent_child_rel
   for known_ptr :: "(_::linorder) 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 get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_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 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
 lemma preserves_wellformedness_writes_needed:
   assumes heap_is_wellformed: "heap_is_wellformed h"
     and "h \<turnstile> f \<rightarrow>\<^sub>h h'"
     and "writes SW f h h'"
     and preserved_get_child_nodes:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                       \<Longrightarrow> \<forall>object_ptr. \<forall>r \<in> get_child_nodes_locs object_ptr. r h h'"
     and preserved_get_disconnected_nodes:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                       \<Longrightarrow> \<forall>document_ptr. \<forall>r \<in> get_disconnected_nodes_locs document_ptr. r h h'"
     and preserved_object_pointers:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                      \<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
   shows "heap_is_wellformed h'"
 proof -
   have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'"
     using assms(2) assms(3) object_ptr_kinds_preserved preserved_object_pointers by blast
   then have object_ptr_kinds_eq:
     "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     by auto
   have children_eq:
     "\<And>ptr children. 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 assms(3) assms(2)])
     using preserved_get_child_nodes by fast
   then have children_eq2: "\<And>ptr. |h \<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:
     "\<And>document_ptr disconnected_nodes.
         h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
                              = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads assms(3) assms(2)])
     using preserved_get_disconnected_nodes by fast
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r
                             = |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     using select_result_eq by force
   have get_parent_eq: "\<And>ptr parent. h \<turnstile> get_parent ptr \<rightarrow>\<^sub>r parent = h' \<turnstile> get_parent ptr \<rightarrow>\<^sub>r parent"
     apply(rule reads_writes_preserved[OF get_parent_reads assms(3) assms(2)])
     using preserved_get_child_nodes preserved_object_pointers unfolding get_parent_locs_def by fast
   have "a_acyclic_heap h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
   proof
     fix x
     assume "x \<in> parent_child_rel h'"
     then show "x \<in> parent_child_rel h"
       by(simp add: parent_child_rel_def  children_eq2 object_ptr_kinds_eq3)
   qed
   then have "a_acyclic_heap h'"
     using \<open>a_acyclic_heap h\<close> acyclic_heap_def acyclic_subset by blast
 
   moreover have "a_all_ptrs_in_heap h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   then have "a_all_ptrs_in_heap h'"
     by (simp add: children_eq2 disconnected_nodes_eq2 document_ptr_kinds_eq3
         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_eq3 object_ptr_kinds_eq3)
 
   moreover have h0: "a_distinct_lists h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   have h1: "map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))
          = map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))"
     by (simp add: children_eq2 object_ptr_kinds_eq3)
   have h2: "map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                (sorted_list_of_set (fset (document_ptr_kinds h)))
           = map (\<lambda>document_ptr. |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                 (sorted_list_of_set (fset (document_ptr_kinds h')))"
     using disconnected_nodes_eq document_ptr_kinds_eq2 select_result_eq by force
   have "a_distinct_lists h'"
     using h0
     by(simp add: a_distinct_lists_def h1 h2)
 
   moreover have "a_owner_document_valid h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2
         object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3)
   ultimately show ?thesis
     by (simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_get_parent_wf2?: 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 parent_child_rel get_disconnected_nodes
   get_disconnected_nodes_locs
   using l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
   by (simp add: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 
 declare l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 locale l_get_parent_wf = l_type_wf + l_known_ptrs  + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_get_parent_defs +
   assumes child_parent_dual:
     "heap_is_wellformed h
     \<Longrightarrow> type_wf h
     \<Longrightarrow> known_ptrs h
     \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
     \<Longrightarrow> child \<in> set children
     \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
   assumes heap_wellformed_induct [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> P parent)
     \<Longrightarrow> P ptr"
   assumes heap_wellformed_induct_rev [consumes 1, case_names step]:
     "heap_is_wellformed h
     \<Longrightarrow> (\<And>child. (\<And>parent child_node. cast child_node = child
     \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent) \<Longrightarrow> P child)
     \<Longrightarrow> P ptr"
   assumes parent_child_rel_parent: "heap_is_wellformed h
     \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent
     \<Longrightarrow> (parent, cast child_node) \<in> parent_child_rel h"
 
 lemma get_parent_wf_is_l_get_parent_wf [instances]:
   "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel
   get_child_nodes get_parent"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def)[1]
   using child_parent_dual heap_wellformed_induct heap_wellformed_induct_rev parent_child_rel_parent
   by metis+
 
 
 
 subsection \<open>get\_disconnected\_nodes\<close>
 
 
 
 subsection \<open>set\_disconnected\_nodes\<close>
 
 
 subsubsection \<open>get\_disconnected\_nodes\<close>
 
 locale l_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
   type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs
   + l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     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 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 heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     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"
 begin
 
 lemma remove_from_disconnected_nodes_removes:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes"
   assumes "h \<turnstile> set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \<rightarrow>\<^sub>h h'"
   assumes "h' \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes'"
   shows "node_ptr \<notin> set disc_nodes'"
   using assms
   by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct
       set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1)
       returns_result_eq)
 end
 
 locale l_set_disconnected_nodes_get_disconnected_nodes_wf = l_heap_is_wellformed
   + l_set_disconnected_nodes_get_disconnected_nodes +
   assumes remove_from_disconnected_nodes_removes:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes
                           \<Longrightarrow> h \<turnstile> set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> h' \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes'
                           \<Longrightarrow> node_ptr \<notin> set disc_nodes'"
 
 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
   parent_child_rel get_child_nodes
   using instances
   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)
 declare 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_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 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 remove_from_disconnected_nodes_removes apply fast
   done
 
 
 subsection \<open>get\_root\_node\<close>
 
 locale l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   + 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
   + 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_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
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     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_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_ancestors :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog"
     and get_ancestors_locs :: "((_) 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"
 
 begin
 lemma get_ancestors_reads:
   assumes "heap_is_wellformed h"
   shows "reads get_ancestors_locs (get_ancestors node_ptr) h h'"
 proof (insert assms(1), induct rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
     using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def]
     apply(simp (no_asm) add: get_ancestors_def)
     by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers
         intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
         reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads]
         split: option.splits)
 qed
 
 lemma get_ancestors_ok:
   assumes "heap_is_wellformed h"
     and "ptr |\<in>| object_ptr_kinds h"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h \<turnstile> ok (get_ancestors ptr)"
 proof (insert assms(1) assms(2), induct rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
     using assms(3) assms(4)
     apply(simp (no_asm) add: get_ancestors_def)
     apply(simp add: assms(1) get_parent_parent_in_heap)
     by(auto intro!: bind_is_OK_pure_I bind_pure_I get_parent_ok split: option.splits)
 qed
 
 lemma get_root_node_ptr_in_heap:
   assumes "h \<turnstile> ok (get_root_node ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   unfolding get_root_node_def
   using get_ancestors_ptr_in_heap
   by auto
 
 
 lemma get_root_node_ok:
   assumes "heap_is_wellformed h" "known_ptrs h" "type_wf h"
     and "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_root_node ptr)"
   unfolding get_root_node_def
   using assms get_ancestors_ok
   by auto
 
 
 lemma get_ancestors_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent"
   shows "h \<turnstile> get_ancestors (cast child) \<rightarrow>\<^sub>r (cast child) # parent # ancestors
      \<longleftrightarrow> h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
 proof
   assume a1: "h \<turnstile> get_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) \<rightarrow>\<^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 # parent # ancestors"
   then have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap (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))
           (\<lambda>_. Heap_Error_Monad.bind (get_parent child)
               (\<lambda>x. Heap_Error_Monad.bind (case x of None \<Rightarrow> return [] | Some x \<Rightarrow> get_ancestors x)
                (\<lambda>ancestors. 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 child # ancestors))))
         \<rightarrow>\<^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 # parent # ancestors"
     by(simp add: get_ancestors_def)
   then show "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
     using assms(2) apply(auto elim!: bind_returns_result_E2 split: option.splits)[1]
     using returns_result_eq by fastforce
 next
   assume "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
   then show "h \<turnstile> get_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) \<rightarrow>\<^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 # parent # ancestors"
     using assms(2)
     apply(simp (no_asm) add: get_ancestors_def)
     apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I
         local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust
         select_result_I)
 qed
 
 
 lemma get_ancestors_never_empty:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors"
   shows "ancestors \<noteq> []"
 proof(insert assms(2), induct arbitrary: ancestors rule: heap_wellformed_induct_rev[OF assms(1)])
   case (1 child)
   then 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
     then show ?case
       apply(simp add: get_ancestors_def)
       by(auto elim!: bind_returns_result_E2 split: option.splits)
   next
     case (Some child_node)
     then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r parent_opt"
       apply(simp add: get_ancestors_def)
       by(auto elim!: bind_returns_result_E2 split: option.splits)
     with Some show ?case
     proof(induct parent_opt)
       case None
       then show ?case
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits)
     next
       case (Some option)
       then show ?case
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits)
     qed
   qed
 qed
 
 
 
 lemma get_ancestors_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors 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)
   case (step child)
   have "child |\<in>| object_ptr_kinds h"
     using get_ancestors_ptr_in_heap step(2) by auto
       (*  then have "h \<turnstile> check_in_heap child \<rightarrow>\<^sub>r ()"
     using returns_result_select_result by force *)
   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
     then have "ancestors = [child]"
       using step(2) step(3)
       by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2)
     show ?case
       using step(2) step(3)
       apply(auto simp add: \<open>ancestors = [child]\<close>)[1]
       using assms(4) returns_result_eq by fastforce
   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(2) step(3) s1
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       show ?case
         using step(2) step(3)
         apply(auto simp add: \<open>ancestors = [child]\<close>)[1]
         using assms(4) returns_result_eq by fastforce
     next
       case (Some parent)
       have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap child)
           (\<lambda>_. Heap_Error_Monad.bind
                  (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 child of None \<Rightarrow> return []
                   | Some node_ptr \<Rightarrow> Heap_Error_Monad.bind (get_parent node_ptr)
                                          (\<lambda>parent_ptr_opt. case parent_ptr_opt of None \<Rightarrow> return []
                                                                         | Some x \<Rightarrow> get_ancestors x))
                  (\<lambda>ancestors. return (child # ancestors)))
     \<rightarrow>\<^sub>r  ancestors"
         using step(2)
         by(simp add: get_ancestors_def)
       moreover obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
         using calculation
         by(auto elim!: bind_returns_result_E2 split: option.splits)
       ultimately have "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors"
         using s1 Some
         by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       show ?case
         using step(1)[OF s1[symmetric, simplified] Some \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors\<close>]
           step(3)
         apply(auto simp add: tl_ancestors)[1]
         by (metis assms(4) insert_iff list.simps(15) local.step(2) returns_result_eq tl_ancestors)
     qed
   qed
 qed
 
 lemma get_ancestors_also_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors 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 (cast child) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(4) get_ancestors_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_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_subset by blast
 qed
 
 lemma get_ancestors_obtains_children:
   assumes "heap_is_wellformed h"
     and "ancestor \<noteq> ptr"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
   obtains children ancestor_child where "h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children"
     and "ancestor_child \<in> set children" and "cast ancestor_child \<in> set ancestors"
 proof -
   assume 0: "(\<And>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 ancestors
         \<Longrightarrow> thesis)"
   have "\<exists>child. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ancestor \<and> cast child \<in> set ancestors"
   proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors
       rule: heap_wellformed_induct_rev)
     case (step child)
     have "child |\<in>| object_ptr_kinds h"
       using get_ancestors_ptr_in_heap step(4) by auto
     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
       then have "ancestors = [child]"
         using step(3) step(4)
         by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2)
       show ?case
         using step(2) step(3) step(4)
         by(auto simp add: \<open>ancestors = [child]\<close>)
     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]
         using get_parent_ok known_ptrs type_wf
         by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute
             node_ptr_kinds_commutes)
       then show ?case
       proof (induct parent_opt)
         case None
         then have "ancestors = [child]"
           using step(2) step(3) step(4) s1
           apply(simp add: get_ancestors_def)
           by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
         show ?case
           using step(2) step(3) step(4)
           by(auto simp add: \<open>ancestors = [child]\<close>)
       next
         case (Some parent)
         have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap child)
             (\<lambda>_. Heap_Error_Monad.bind
                    (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 child of None \<Rightarrow> return []
                     | Some node_ptr \<Rightarrow> Heap_Error_Monad.bind (get_parent node_ptr)
                        (\<lambda>parent_ptr_opt. case parent_ptr_opt of None \<Rightarrow> return []
                                                               | Some x \<Rightarrow> get_ancestors x))
                    (\<lambda>ancestors. return (child # ancestors)))
       \<rightarrow>\<^sub>r  ancestors"
           using step(4)
           by(simp add: get_ancestors_def)
         moreover obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
           using calculation
           by(auto elim!: bind_returns_result_E2 split: option.splits)
         ultimately have "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors"
           using s1 Some
           by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
             (* have "ancestor \<noteq> parent" *)
         have "ancestor \<in> set tl_ancestors"
           using tl_ancestors step(2) step(3) by auto
         show ?case
         proof (cases "ancestor \<noteq> parent")
           case True
           show ?thesis
             using step(1)[OF s1[symmetric, simplified] Some True
                 \<open>ancestor \<in> set tl_ancestors\<close> \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors\<close>]
             using tl_ancestors by auto
         next
           case False
           have "child \<in> set ancestors"
             using step(4) get_ancestors_ptr by simp
           then show ?thesis
             using Some False s1[symmetric] by(auto)
         qed
       qed
     qed
   qed
   then obtain child where child: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ancestor"
     and in_ancestors: "cast child \<in> set ancestors"
     by auto
   then obtain children where
     children: "h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children" and
     child_in_children: "child \<in> set children"
     using get_parent_child_dual by blast
   show thesis
     using 0[OF children child_in_children] child assms(3) in_ancestors by blast
 qed
 
 lemma get_ancestors_parent_child_rel:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "(ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 proof (safe)
   assume 3: "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   show "ptr \<in> set ancestors"
   proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)])
     case (1 ptr)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by (metis (no_types, lifting) assms(2) bind_returns_result_E get_ancestors_def
             in_set_member member_rec(1) return_returns_result)
     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(2)] \<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 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 local.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 known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr
               local.parent_child_rel_child ptr_child ptr_child_ptr_child_node
               returns_result_select_result type_wf)
         ultimately show ?thesis
           using a1 get_child_nodes_ok type_wf known_ptrs
           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 known_ptrs type_wf by blast
       ultimately show ?thesis
         using get_ancestors_also_parent assms type_wf by blast
     qed
   qed
 next
   assume 3: "ptr \<in> set ancestors"
   show "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)])
     case (1 ptr)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by simp
     next
       case False
       then obtain children ptr_child_node where
         children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children" and
         ptr_child_node: "ptr_child_node \<in> set children" and
         ptr_child_node_in_ancestors: "cast ptr_child_node \<in> set ancestors"
         using 1(2) assms(2) get_ancestors_obtains_children assms(1)
         using known_ptrs type_wf by blast
       then 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 1(1) by blast
 
       moreover have "(ptr, cast ptr_child_node) \<in> parent_child_rel h"
         using children ptr_child_node assms(1) parent_child_rel_child_nodes2
         using child_parent_dual known_ptrs parent_child_rel_parent type_wf
         by blast
 
       ultimately show ?thesis
         by auto
     qed
   qed
 qed
 
 lemma get_root_node_parent_child_rel:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_root_node child \<rightarrow>\<^sub>r root"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "(root, child) \<in> (parent_child_rel h)\<^sup>*"
   using assms get_ancestors_parent_child_rel
   apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1]
   using get_ancestors_never_empty last_in_set by blast
 
 
 lemma get_ancestors_eq:
   assumes "heap_is_wellformed h"
     and "heap_is_wellformed h'"
     and "\<And>object_ptr w. object_ptr \<noteq> ptr \<Longrightarrow> w \<in> get_child_nodes_locs object_ptr \<Longrightarrow> w h h'"
     and pointers_preserved: "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
     and known_ptrs: "known_ptrs h"
     and known_ptrs': "known_ptrs h'"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and type_wf: "type_wf h"
     and type_wf': "type_wf h'"
   shows "h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
 proof -
   have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'"
     using pointers_preserved object_ptr_kinds_preserved_small by blast
   then 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"
     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)
   have "h' \<turnstile> ok (get_ancestors ptr)"
     using get_ancestors_ok get_ancestors_ptr_in_heap object_ptr_kinds_eq3 assms(1) known_ptrs
       known_ptrs' assms(2) assms(7) type_wf'
     by blast
   then obtain ancestors' where ancestors': "h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors'"
     by auto
 
   obtain root where root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   proof -
     assume 0: "(\<And>root. h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow> thesis)"
     show thesis
       apply(rule 0)
       using assms(7)
       by(auto simp add: get_root_node_def elim!: bind_returns_result_E2 split: option.splits)
   qed
 
   have children_eq:
     "\<And>p children. p \<noteq> ptr \<Longrightarrow> h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads assms(3)
     apply(simp add: reads_def reflp_def transp_def preserved_def)
     by blast
 
   have "acyclic (parent_child_rel h)"
     using assms(1) local.parent_child_rel_acyclic by auto
   have "acyclic (parent_child_rel h')"
     using assms(2) local.parent_child_rel_acyclic by blast
   have 2: "\<And>c parent_opt. 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 c \<in> set ancestors \<inter> set ancestors'
           \<Longrightarrow> h \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt = h' \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt"
   proof -
     fix c parent_opt
     assume 1: " 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 c \<in> set ancestors \<inter> set ancestors'"
 
     obtain ptrs where ptrs: "h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
       by simp
 
     let ?P = "(\<lambda>ptr. Heap_Error_Monad.bind (get_child_nodes ptr) (\<lambda>children. return (c \<in> set children)))"
     have children_eq_True: "\<And>p. p \<in> set ptrs \<Longrightarrow> h \<turnstile> ?P p \<rightarrow>\<^sub>r True \<longleftrightarrow> h' \<turnstile> ?P p \<rightarrow>\<^sub>r True"
     proof -
       fix p
       assume "p \<in> set ptrs"
       then show "h \<turnstile> ?P p \<rightarrow>\<^sub>r True \<longleftrightarrow> h' \<turnstile> ?P p \<rightarrow>\<^sub>r True"
       proof (cases "p = ptr")
         case True
         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 c, ptr) \<in> (parent_child_rel h)\<^sup>*"
           using get_ancestors_parent_child_rel 1 assms by blast
         then have "(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 c) \<notin> (parent_child_rel h)"
         proof (cases "cast c = ptr")
           case True
           then show ?thesis
             using \<open>acyclic (parent_child_rel h)\<close> by(auto simp add: acyclic_def)
         next
           case False
           then have "(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 c) \<notin> (parent_child_rel h)\<^sup>*"
             using \<open>acyclic (parent_child_rel h)\<close> False rtrancl_eq_or_trancl rtrancl_trancl_trancl
               \<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 c, ptr) \<in> (parent_child_rel h)\<^sup>*\<close>
             by (metis acyclic_def)
           then show ?thesis
             using r_into_rtrancl by auto
         qed
         obtain children where children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
           using type_wf
           by (metis \<open>h' \<turnstile> ok get_ancestors ptr\<close> assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok
               heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr
               object_ptr_kinds_eq3)
         then have "c \<notin> set children"
           using \<open>(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 c) \<notin> (parent_child_rel h)\<close> assms(1)
           using parent_child_rel_child_nodes2
           using child_parent_dual known_ptrs parent_child_rel_parent
             type_wf by blast
         with children have "h \<turnstile> ?P p \<rightarrow>\<^sub>r False"
           by(auto simp add: True)
 
         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 c, ptr) \<in> (parent_child_rel h')\<^sup>*"
           using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf
             type_wf' by blast
         then have "(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 c) \<notin> (parent_child_rel h')"
         proof (cases "cast c = ptr")
           case True
           then show ?thesis
             using \<open>acyclic (parent_child_rel h')\<close> by(auto simp add: acyclic_def)
         next
           case False
           then have "(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 c) \<notin> (parent_child_rel h')\<^sup>*"
             using \<open>acyclic (parent_child_rel h')\<close> False rtrancl_eq_or_trancl rtrancl_trancl_trancl
               \<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 c, ptr) \<in> (parent_child_rel h')\<^sup>*\<close>
             by (metis acyclic_def)
           then show ?thesis
             using r_into_rtrancl by auto
         qed
         then have "(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 c) \<notin> (parent_child_rel h')"
           using r_into_rtrancl by auto
         obtain children' where children': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'"
           using  type_wf  type_wf'
           by (meson \<open>h' \<turnstile> ok (get_ancestors ptr)\<close> assms(2) get_ancestors_ptr_in_heap
               get_child_nodes_ok is_OK_returns_result_E known_ptrs'
               local.known_ptrs_known_ptr)
         then have "c \<notin> set children'"
           using \<open>(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 c) \<notin> (parent_child_rel h')\<close> assms(2)  type_wf  type_wf'
           using parent_child_rel_child_nodes2 child_parent_dual known_ptrs' parent_child_rel_parent
           by auto
         with children' have "h' \<turnstile> ?P p \<rightarrow>\<^sub>r False"
           by(auto simp add: True)
 
         ultimately show ?thesis
           by (metis returns_result_eq)
       next
         case False
         then show ?thesis
           using children_eq ptrs
           by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E
               get_child_nodes_pure return_returns_result)
       qed
     qed
     have "\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                      \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                      \<bind> (\<lambda>children. return (c \<in> set children)))"
       using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf  type_wf'
       by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I
           get_child_nodes_ok get_child_nodes_pure known_ptrs'
           local.known_ptrs_known_ptr return_ok select_result_I2)
     have children_eq_False:
       "\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False = h' \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
     proof
       fix pa
       assume "pa \<in> set ptrs"
         and "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
       have "h \<turnstile> ok (get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))
            \<Longrightarrow> h' \<turnstile> ok ( get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))"
         using \<open>pa \<in> set ptrs\<close> \<open>\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                     \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                     \<bind> (\<lambda>children. return (c \<in> set children)))\<close>
         by auto
       moreover have "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False
         \<Longrightarrow> h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         by (metis (mono_tags, lifting) \<open>\<And>pa. pa \<in> set ptrs
               \<Longrightarrow> h \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True = h' \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True\<close> \<open>pa \<in> set ptrs\<close>
             calculation is_OK_returns_result_I returns_result_eq returns_result_select_result)
       ultimately show "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         using \<open>h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False\<close>
         by auto
     next
       fix pa
       assume "pa \<in> set ptrs"
         and "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
       have "h' \<turnstile> ok (get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))
             \<Longrightarrow> h \<turnstile> ok ( get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))"
         using \<open>pa \<in> set ptrs\<close> \<open>\<And>pa. pa \<in> set ptrs
               \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)))\<close>
         by auto
       moreover have "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False
                   \<Longrightarrow> h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         by (metis (mono_tags, lifting)
             \<open>\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> get_child_nodes pa
                         \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True = h' \<turnstile> get_child_nodes pa
                         \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True\<close> \<open>pa \<in> set ptrs\<close>
             calculation is_OK_returns_result_I returns_result_eq returns_result_select_result)
       ultimately show "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         using \<open>h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False\<close> by blast
     qed
 
     have filter_eq: "\<And>xs. h \<turnstile> filter_M ?P ptrs \<rightarrow>\<^sub>r xs = h' \<turnstile> filter_M ?P ptrs \<rightarrow>\<^sub>r xs"
     proof (rule filter_M_eq)
       show
         "\<And>xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children))) h"
         by(auto intro!: bind_pure_I)
     next
       show
         "\<And>xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children))) h'"
         by(auto intro!: bind_pure_I)
     next
       fix xs b x
       assume 0: "x \<in> set ptrs"
       then show "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r b
               = h' \<turnstile> Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r b"
         apply(induct b)
         using children_eq_True apply blast
         using children_eq_False apply blast
         done
     qed
 
     show "h \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt = h' \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt"
       apply(simp add: get_parent_def)
       apply(rule bind_cong_2)
          apply(simp)
         apply(simp)
        apply(simp add: check_in_heap_def node_ptr_kinds_def object_ptr_kinds_eq3)
       apply(rule bind_cong_2)
          apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
         apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
        apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
       apply(rule bind_cong_2)
          apply(auto intro!: filter_M_pure_I bind_pure_I)[1]
         apply(auto intro!: filter_M_pure_I bind_pure_I)[1]
        apply(auto simp add: filter_eq (* dest!: returns_result_eq[OF ptrs] *))[1]
       using filter_eq ptrs apply auto[1]
       using filter_eq ptrs by auto
   qed
 
   have "ancestors = ancestors'"
   proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors'
       rule: heap_wellformed_induct_rev)
     case (step child)
     show ?case
       using step(2) step(3) step(4)
       apply(simp add: get_ancestors_def)
       apply(auto intro!: elim!: bind_returns_result_E2 split: option.splits)[1]
       using returns_result_eq apply fastforce
        apply (meson option.simps(3) returns_result_eq)
       by (metis IntD1 IntD2 option.inject returns_result_eq step.hyps)
   qed
   then show ?thesis
     using assms(5) ancestors'
     by simp
 qed
 
 lemma get_ancestors_remains_not_in_ancestors:
   assumes "heap_is_wellformed h"
     and "heap_is_wellformed h'"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and "h' \<turnstile> get_ancestors 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 "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(6), induct ptr arbitrary: ancestors ancestors'
       rule: heap_wellformed_induct_rev)
     case (step child)
     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 "node \<noteq> child"
       using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs
       using type_wf type_wf'
       by blast
     then show ?case
       using step(2) step(3)
       apply(simp add: get_ancestors_def)
       using step(4)
       apply(auto elim!: bind_returns_result_E2 split: option.splits)[1]
       using 1
        apply (meson option.distinct(1) returns_result_eq)
       by (metis "1" option.inject returns_result_eq step.hyps)
   qed
 qed
 
 lemma get_ancestors_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors 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 x \<rightarrow>\<^sub>r a # ancestors"
     by(auto simp add: get_ancestors_def[of a] elim!: bind_returns_result_E2 split: option.splits)
   then have "x = a"
     by(auto simp add: get_ancestors_def[of x] elim!: bind_returns_result_E2 split: option.splits)
   then show ?case
     using Cons.hyps Cons.prems(2) get_ancestors_ptr_in_heap x
     by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap
         is_OK_returns_result_I)
 qed
 
 
 lemma get_ancestors_prefix:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
   assumes "ptr' \<in> set ancestors"
   assumes "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
   shows "\<exists>pre. ancestors = pre @ ancestors'"
 proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors'
     rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
   proof (cases "parent \<noteq> ptr" )
     case True
 
     then obtain children ancestor_child where "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
       and "ancestor_child \<in> set children" and "cast ancestor_child \<in> set ancestors"
       using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast
     then have "h \<turnstile> get_parent ancestor_child \<rightarrow>\<^sub>r Some parent"
       using assms(1) assms(2) assms(3) child_parent_dual by blast
     then have "h \<turnstile> get_ancestors (cast ancestor_child) \<rightarrow>\<^sub>r cast ancestor_child # ancestors'"
       apply(simp add: get_ancestors_def)
       using \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r ancestors'\<close> get_parent_ptr_in_heap
       by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I)
     then show ?thesis
       using step(1) \<open>h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children\<close> \<open>ancestor_child \<in> set children\<close>
         \<open>cast ancestor_child \<in> set ancestors\<close>
         \<open>h \<turnstile> get_ancestors (cast ancestor_child) \<rightarrow>\<^sub>r cast ancestor_child # ancestors'\<close>
       by fastforce
   next
     case False
     then show ?thesis
       by (metis append_Nil assms(4) returns_result_eq step.prems(2))
   qed
 qed
 
 
 lemma get_ancestors_same_root_node:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
   assumes "ptr' \<in> set ancestors"
   assumes "ptr'' \<in> set ancestors"
   shows "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr \<longleftrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
 proof -
   have "ptr' |\<in>| object_ptr_kinds h"
     by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children
         get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I)
   then obtain ancestors' where ancestors': "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
     by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E)
   then have "\<exists>pre. ancestors = pre @ ancestors'"
     using get_ancestors_prefix assms by blast
   moreover have "ptr'' |\<in>| object_ptr_kinds h"
     by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children
         get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I)
   then obtain ancestors'' where ancestors'': "h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''"
     by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E)
   then have "\<exists>pre. ancestors = pre @ ancestors''"
     using get_ancestors_prefix assms by blast
   ultimately show ?thesis
     using ancestors' ancestors''
     apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I)[1]
      apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR
         returns_result_eq)
     by (metis assms(1) get_ancestors_never_empty last_appendR returns_result_eq)
 qed
 
 lemma get_root_node_parent_same:
   assumes "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
   shows "h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root \<longleftrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
 proof
   assume 1: " h \<turnstile> get_root_node (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 root"
   show "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     using 1[unfolded get_root_node_def] assms
     apply(simp add: get_ancestors_def)
     apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I split: option.splits)[1]
     using returns_result_eq apply fastforce
     using get_ancestors_ptr by fastforce
 next
   assume 1: " h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   show "h \<turnstile> get_root_node (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 root"
     apply(simp add: get_root_node_def)
     using assms 1
     apply(simp add: get_ancestors_def)
     apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I split: option.splits)[1]
      apply (simp add: check_in_heap_def is_OK_returns_result_I)
     using get_ancestors_ptr get_parent_ptr_in_heap
     apply (simp add: is_OK_returns_result_I)
     by (meson list.distinct(1) list.set_cases local.get_ancestors_ptr)
 qed
 
 lemma get_root_node_same_no_parent:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node 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)
   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 have "c = cast child"
       using step(2)
       by(auto simp add: get_root_node_def get_ancestors_def[of c] elim!: bind_returns_result_E2)
     then show ?thesis
       using None by auto
   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"
       by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap
           is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute
           node_ptr_kinds_commutes returns_result_select_result step.prems)
     then show ?thesis
     proof(induct parent_opt)
       case None
       then show ?case
         using Some get_root_node_no_parent returns_result_eq step.prems by fastforce
     next
       case (Some parent)
       then show ?case
         using step s
         apply(auto simp add: get_root_node_def get_ancestors_def[of c]
             elim!: bind_returns_result_E2 split: option.splits list.splits)[1]
         using get_root_node_parent_same step.hyps step.prems by auto
     qed
   qed
 qed
 
 lemma get_root_node_not_node_same:
   assumes "ptr |\<in>| object_ptr_kinds h"
   assumes "\<not>is_node_ptr_kind ptr"
   shows "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r ptr"
   using assms
   apply(simp add: get_root_node_def get_ancestors_def)
   by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
       intro!: bind_pure_returns_result_I split: option.splits)
 
 
 lemma get_root_node_root_in_heap:
   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 "root |\<in>| object_ptr_kinds h"
   using assms
   apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1]
   by (simp add: get_ancestors_never_empty get_ancestors_ptrs_in_heap)
 
 
 lemma get_root_node_same_no_parent_parent_child_rel:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r ptr'"
   shows "\<not>(\<exists>p. (p, ptr') \<in> (parent_child_rel h))"
   by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent
       l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok
       local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr
       local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq
       returns_result_select_result)
 
 end
 
 
 locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs
   + l_get_child_nodes_defs + l_get_parent_defs +
   assumes get_ancestors_never_empty:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ancestors \<noteq> []"
   assumes get_ancestors_ok:
     "heap_is_wellformed h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> h \<turnstile> ok (get_ancestors ptr)"
   assumes get_ancestors_reads:
     "heap_is_wellformed h \<Longrightarrow> reads get_ancestors_locs (get_ancestors node_ptr) h h'"
   assumes get_ancestors_ptrs_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ptr' \<in> set ancestors
                           \<Longrightarrow> ptr' |\<in>| object_ptr_kinds h"
   assumes get_ancestors_remains_not_in_ancestors:
     "heap_is_wellformed h \<Longrightarrow> heap_is_wellformed h' \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors
                           \<Longrightarrow> h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors'
                           \<Longrightarrow> (\<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)
                           \<Longrightarrow> node \<notin> set ancestors
                           \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> type_wf h' \<Longrightarrow> node \<notin> set ancestors'"
   assumes get_ancestors_also_parent:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors some_ptr \<rightarrow>\<^sub>r ancestors
                           \<Longrightarrow> cast child_node \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> type_wf h
                           \<Longrightarrow> known_ptrs h \<Longrightarrow> parent \<in> set ancestors"
   assumes get_ancestors_obtains_children:
     "heap_is_wellformed h \<Longrightarrow> ancestor \<noteq> ptr \<Longrightarrow> ancestor \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> (\<And>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"
   assumes get_ancestors_parent_child_rel:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> (ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 
 locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf
   + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs +
   assumes get_root_node_ok:
     "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h
                           \<Longrightarrow> h \<turnstile> ok (get_root_node ptr)"
   assumes get_root_node_ptr_in_heap:
     "h \<turnstile> ok (get_root_node ptr) \<Longrightarrow> ptr |\<in>| object_ptr_kinds h"
   assumes get_root_node_root_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow> root |\<in>| object_ptr_kinds h"
   assumes get_ancestors_same_root_node:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ptr' \<in> set ancestors
                           \<Longrightarrow> ptr'' \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr \<longleftrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
   assumes get_root_node_same_no_parent:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r cast child \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
   assumes get_root_node_parent_same:
     "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr
         \<Longrightarrow> h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root \<longleftrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
 
 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
   using instances
   by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 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"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def)[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_parent_same apply (blast, blast)
   done
 
 
 subsection \<open>to\_tree\_order\<close>
 
 locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent +
   l_get_parent_wf +
   l_heap_is_wellformed
   (* l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M *)
 begin
 
 lemma to_tree_order_ptr_in_heap:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> ok (to_tree_order ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
 proof(insert assms(1) assms(4), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
     apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_is_OK_E3)[1]
     using get_child_nodes_ptr_in_heap by blast
 qed
 
 lemma to_tree_order_either_ptr_or_in_children:
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "node \<in> set nodes"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and "node \<noteq> ptr"
   obtains child child_to where "child \<in> set children"
     and "h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r child_to" and "node \<in> set child_to"
 proof -
   obtain treeorders where treeorders: "h \<turnstile> map_M to_tree_order (map cast children) \<rightarrow>\<^sub>r treeorders"
     using assms
     apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1]
     using pure_returns_heap_eq returns_result_eq by fastforce
   then have "node \<in> set (concat treeorders)"
     using assms[simplified to_tree_order_def]
     by(auto elim!: bind_returns_result_E4 dest: pure_returns_heap_eq)
   then obtain treeorder where "treeorder \<in> set treeorders"
     and node_in_treeorder: "node \<in> set treeorder"
     by auto
   then obtain child where "h \<turnstile> to_tree_order (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 treeorder"
     and  "child \<in> set children"
     using assms[simplified to_tree_order_def] treeorders
     by(auto elim!: map_M_pure_E2)
   then show ?thesis
     using node_in_treeorder returns_result_eq that by auto
 qed
 
 
 lemma to_tree_order_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   shows "ptr' |\<in>| object_ptr_kinds h"
 proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wellformed_induct)
   case (step parent)
   have "parent |\<in>| object_ptr_kinds h"
     using assms(1) assms(2) assms(3) step.prems(1) to_tree_order_ptr_in_heap by blast
   then obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then have "to = [parent]"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_returns_result_E2)[1]
       by (metis list.distinct(1) list.map_disc_iff list.set_cases map_M_pure_E2 returns_result_eq)
     then show ?thesis
       using \<open>parent |\<in>| object_ptr_kinds h\<close> step.prems(2) by auto
   next
     case False
     note f = this
     then show ?thesis
       using children step to_tree_order_either_ptr_or_in_children
     proof (cases "ptr' = parent")
       case True
       then show ?thesis
         using \<open>parent |\<in>| object_ptr_kinds h\<close> by blast
     next
       case False
       then show ?thesis
         using children step.hyps to_tree_order_either_ptr_or_in_children
         by (metis step.prems(1) step.prems(2))
     qed
   qed
 qed
 
 lemma to_tree_order_ok:
   assumes wellformed: "heap_is_wellformed h"
     and "ptr |\<in>| object_ptr_kinds h"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h \<turnstile> ok (to_tree_order ptr)"
 proof(insert assms(1) assms(2), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
     using assms(3) type_wf
     apply(simp add: to_tree_order_def)
     apply(auto simp add: heap_is_wellformed_def intro!: map_M_ok_I bind_is_OK_pure_I map_M_pure_I)[1]
     using get_child_nodes_ok known_ptrs_known_ptr apply blast
     by (simp add: local.heap_is_wellformed_children_in_heap local.to_tree_order_def wellformed)
 qed
 
 lemma to_tree_order_child_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and "node \<in> set children"
     and "h \<turnstile> to_tree_order (cast node) \<rightarrow>\<^sub>r nodes'"
   shows "set nodes' \<subseteq> set nodes"
 proof
   fix x
   assume a1: "x \<in> set nodes'"
   moreover obtain treeorders
     where treeorders: "h \<turnstile> map_M to_tree_order (map cast children) \<rightarrow>\<^sub>r treeorders"
     using assms(2) assms(3)
     apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1]
     using pure_returns_heap_eq returns_result_eq by fastforce
   then have "nodes' \<in> set treeorders"
     using assms(4) assms(5)
     by(auto elim!: map_M_pure_E dest: returns_result_eq)
   moreover have "set (concat treeorders) \<subseteq> set nodes"
     using treeorders assms(2) assms(3)
     by(auto simp add: to_tree_order_def elim!: bind_returns_result_E4 dest: pure_returns_heap_eq)
   ultimately show "x \<in> set nodes"
     by auto
 qed
 
 lemma to_tree_order_ptr_in_result:
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   shows "ptr \<in> set nodes"
   using assms
   apply(simp add: to_tree_order_def)
   by(auto elim!: bind_returns_result_E2 intro!: map_M_pure_I bind_pure_I)
 
 lemma to_tree_order_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "node \<in> set nodes"
     and "h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "set nodes' \<subseteq> set nodes"
 proof -
   have "\<forall>nodes. h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<longrightarrow> (\<forall>node. node \<in> set nodes
        \<longrightarrow> (\<forall>nodes'. h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<longrightarrow> set nodes' \<subseteq> set nodes))"
   proof(insert assms(1), induct ptr rule: heap_wellformed_induct)
     case (step parent)
     then show ?case
     proof safe
       fix nodes node nodes' x
       assume 1: "(\<And>children child.
              h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow>
              child \<in> set children \<Longrightarrow> \<forall>nodes. h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes
             \<longrightarrow> (\<forall>node. node \<in> set nodes \<longrightarrow> (\<forall>nodes'. h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'
                                               \<longrightarrow> set nodes' \<subseteq> set nodes)))"
         and 2: "h \<turnstile> to_tree_order parent \<rightarrow>\<^sub>r nodes"
         and 3: "node \<in> set nodes"
         and "h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'"
         and "x \<in> set nodes'"
       have h1: "(\<And>children child nodes node nodes'.
              h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow>
              child \<in> set children \<Longrightarrow> h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes
              \<longrightarrow> (node \<in> set nodes \<longrightarrow> (h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<longrightarrow> set nodes' \<subseteq> set nodes)))"
         using 1
         by blast
       obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
         using 2
         by(auto simp add: to_tree_order_def elim!: bind_returns_result_E)
       then have "set nodes' \<subseteq> set nodes"
       proof (cases "children = []")
         case True
         then show ?thesis
           by (metis "2" "3" \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> children empty_iff list.set(1)
               subsetI to_tree_order_either_ptr_or_in_children)
       next
         case False
         then show ?thesis
         proof (cases "node = parent")
           case True
           then show ?thesis
             using "2" \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> returns_result_eq by fastforce
         next
           case False
           then obtain child nodes_of_child where
             "child \<in> set children" and
             "h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes_of_child" and
             "node \<in> set nodes_of_child"
             using 2[simplified to_tree_order_def] 3
               to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children
             apply(auto elim!: bind_returns_result_E2 intro: map_M_pure_I)[1]
             using is_OK_returns_result_E 2 a_all_ptrs_in_heap_def assms(1) heap_is_wellformed_def
             using "3" by blast
           then have "set nodes' \<subseteq> set nodes_of_child"
             using h1
             using \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> children by blast
           moreover have "set nodes_of_child \<subseteq> set nodes"
             using "2" \<open>child \<in> set children\<close> \<open>h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes_of_child\<close>
               assms children to_tree_order_child_subset by auto
           ultimately show ?thesis
             by blast
         qed
       qed
       then show "x \<in> set nodes"
         using \<open>x \<in> set nodes'\<close> by blast
     qed
   qed
   then show ?thesis
     using assms by blast
 qed
 
 lemma to_tree_order_parent:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent"
   assumes "parent \<in> set nodes"
   shows "cast child \<in> set nodes"
 proof -
   obtain nodes' where nodes': "h \<turnstile> to_tree_order parent \<rightarrow>\<^sub>r nodes'"
     using assms to_tree_order_ok get_parent_parent_in_heap
     by (meson get_parent_parent_in_heap is_OK_returns_result_E)
 
   then have "set nodes' \<subseteq> set nodes"
     using to_tree_order_subset assms
     by blast
   moreover obtain children where
     children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children" and
     child: "child \<in> set children"
     using assms get_parent_child_dual by blast
   then obtain child_to where child_to: "h \<turnstile> to_tree_order (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 child_to"
     by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I
         get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok)
   then have "cast child \<in> set child_to"
     apply(simp add: to_tree_order_def)
     by(auto elim!: bind_returns_result_E2 map_M_pure_E
         dest!: bind_returns_result_E3[rotated, OF children, rotated]  intro!: map_M_pure_I)
 
   have "cast child \<in> set nodes'"
     using nodes' child
     apply(simp add: to_tree_order_def)
     apply(auto elim!: bind_returns_result_E2 map_M_pure_E
         dest!: bind_returns_result_E3[rotated, OF children, rotated]  intro!: map_M_pure_I)[1]
     using child_to \<open>cast child \<in> set child_to\<close> returns_result_eq by fastforce
   ultimately show ?thesis
     by auto
 qed
 
 lemma to_tree_order_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
   assumes "cast child \<noteq> ptr"
   assumes "child \<in> set children"
   assumes "cast child \<in> set nodes"
   shows "parent \<in> set nodes"
 proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes
     rule: heap_wellformed_induct)
   case (step p)
   have "p |\<in>| object_ptr_kinds h"
     using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
     using assms(1) assms(2) assms(3) by blast
   then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then show ?thesis
       using step(2) step(3) step(4) children
       by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])
   next
     case False
     then obtain c child_to where
       child: "c \<in> set children" and
       child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
       "cast child \<in> set child_to"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
       by (metis (full_types) assms(1) assms(2) assms(3) get_parent_ptr_in_heap
           is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual
           l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes
           returns_result_select_result step.prems(1) step.prems(2) step.prems(3)
           to_tree_order_either_ptr_or_in_children to_tree_order_ok)
     then have "set child_to \<subseteq> set nodes"
       using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
     show ?thesis
     proof (cases "c = child")
       case True
       then have "parent = p"
         using step(3) children child assms(5) assms(7)
         by (meson assms(1) assms(2) assms(3) child_parent_dual option.inject returns_result_eq)
 
       then show ?thesis
         using step.prems(1) to_tree_order_ptr_in_result by blast
     next
       case False
       then show ?thesis
         using step(1)[OF children child child_to] step(3) step(4)
         using \<open>set child_to \<subseteq> set nodes\<close>
         using \<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 child \<in> set child_to\<close> by auto
     qed
   qed
 qed
 
 lemma to_tree_order_node_ptrs:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "ptr' \<noteq> ptr"
   assumes "ptr' \<in> set nodes"
   shows "is_node_ptr_kind ptr'"
 proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes
     rule: heap_wellformed_induct)
   case (step p)
   have "p |\<in>| object_ptr_kinds h"
     using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
     using assms(1) assms(2) assms(3) by blast
   then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then show ?thesis
       using step(2) step(3) step(4) children
       by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
   next
     case False
     then obtain c child_to where
       child: "c \<in> set children" and
       child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
       "ptr' \<in> set child_to"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
       using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast
     then have "set child_to \<subseteq> set nodes"
       using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
     show ?thesis
     proof (cases "cast c = ptr")
       case True
       then show ?thesis
         using step \<open>ptr' \<in> set child_to\<close> assms(5) child child_to children by blast
     next
       case False
       then show ?thesis
         using \<open>ptr' \<in> set child_to\<close> child child_to children is_node_ptr_kind_cast step.hyps by blast
     qed
   qed
 qed
 
 lemma to_tree_order_child2:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "cast child \<noteq> ptr"
   assumes "cast child \<in> set nodes"
   obtains parent where "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent" and "parent \<in> set nodes"
 proof -
   assume 1: "(\<And>parent. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent \<Longrightarrow> parent \<in> set nodes \<Longrightarrow> thesis)"
   show thesis
   proof(insert assms(1) assms(4) assms(5) assms(6) 1, induct ptr arbitrary: nodes
       rule: heap_wellformed_induct)
     case (step p)
     have "p |\<in>| object_ptr_kinds h"
       using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
       using assms(1) assms(2) assms(3) by blast
     then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
       by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
     then show ?case
     proof (cases "children = []")
       case True
       then show ?thesis
         using step(2) step(3) step(4) children
         by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
             dest!: bind_returns_result_E3[rotated, OF children, rotated])
     next
       case False
       then obtain c child_to where
         child: "c \<in> set children" and
         child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
         "cast child \<in> set child_to"
         using step(2) children
         apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
             dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
         using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children
         by blast
       then have "set child_to \<subseteq> set nodes"
         using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
       have "cast child |\<in>| object_ptr_kinds h"
         using assms(1) assms(2) assms(3) assms(4) assms(6) to_tree_order_ptrs_in_heap by blast
       then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r parent_opt"
         by (meson assms(2) assms(3) is_OK_returns_result_E get_parent_ok node_ptr_kinds_commutes)
       then show ?thesis
       proof (induct parent_opt)
         case None
         then show ?case
           by (metis \<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 child \<in> set child_to\<close> assms(1) assms(2) assms(3)
               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_inject child child_parent_dual child_to children
               option.distinct(1) returns_result_eq step.hyps)
       next
         case (Some option)
         then show ?case
           by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2)
               step.prems(3) step.prems(4) to_tree_order_child)
       qed
     qed
   qed
 qed
 
 lemma to_tree_order_parent_child_rel:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   shows "(ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> child \<in> set to"
 proof
   assume 3: "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   show "child \<in> set to"
   proof (insert 3, induct child rule: heap_wellformed_induct_rev[OF assms(1)])
     case (1 child)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         using assms(4)
         apply(simp add: to_tree_order_def)
         by(auto simp add: map_M_pure_I elim!: bind_returns_result_E2)
     next
       case False
       obtain child_parent where
         "(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*" and
         "(child_parent, child) \<in> (parent_child_rel h)"
         using \<open>ptr \<noteq> child\<close>
         by (metis "1.prems" rtranclE)
       obtain child_node where child_node: "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 = child"
         using \<open>(child_parent, child) \<in> parent_child_rel h\<close> node_ptr_casts_commute3
           parent_child_rel_node_ptr
         by blast
       then have "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some child_parent"
         using \<open>(child_parent, child) \<in> (parent_child_rel h)\<close>
         by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual
             l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok
             local.known_ptrs_known_ptr local.l_get_parent_wf_axioms
             local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap)
       then show ?thesis
         using 1(1) child_node \<open>(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*\<close>
         using assms(1) assms(2) assms(3) assms(4) to_tree_order_parent by blast
     qed
   qed
 next
   assume "child \<in> set to"
   then show "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   proof (induct child rule: heap_wellformed_induct_rev[OF assms(1)])
     case (1 child)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by simp
     next
       case False
       then have "\<exists>parent. (parent, child) \<in> (parent_child_rel h)"
         using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)]
           to_tree_order_node_ptrs
         by (metis assms(1) assms(2) assms(3) node_ptr_casts_commute3 parent_child_rel_parent)
       then obtain child_node where child_node: "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 = child"
         using node_ptr_casts_commute3 parent_child_rel_node_ptr by blast
       then obtain child_parent where child_parent: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some child_parent"
         using \<open>\<exists>parent. (parent, child) \<in> (parent_child_rel h)\<close>
         by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) to_tree_order_child2)
       then have "(child_parent, child) \<in> (parent_child_rel h)"
         using assms(1) child_node parent_child_rel_parent by blast
       moreover have "child_parent \<in> set to"
         by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent
             get_parent_child_dual to_tree_order_child)
       then have "(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*"
         using 1 child_node child_parent by blast
       ultimately show ?thesis
         by auto
     qed
   qed
 qed
 end
 
 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
   using instances
   apply(simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
   done
 declare l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_to_tree_order_defs
   + l_get_parent_defs + l_get_child_nodes_defs +
   assumes to_tree_order_ok:
     "heap_is_wellformed h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> h \<turnstile> ok (to_tree_order ptr)"
   assumes to_tree_order_ptrs_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> ptr' \<in> set to \<Longrightarrow> ptr' |\<in>| object_ptr_kinds h"
   assumes to_tree_order_parent_child_rel:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> (ptr, child_ptr) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> child_ptr \<in> set to"
   assumes to_tree_order_child2:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> cast child \<noteq> ptr \<Longrightarrow> cast child \<in> set nodes
                           \<Longrightarrow> (\<And>parent. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent
                                          \<Longrightarrow> parent \<in> set nodes \<Longrightarrow> thesis)
                           \<Longrightarrow> thesis"
   assumes to_tree_order_node_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> ptr' \<noteq> ptr \<Longrightarrow> ptr' \<in> set nodes \<Longrightarrow> is_node_ptr_kind ptr'"
   assumes to_tree_order_child:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow> cast child \<noteq> ptr
                           \<Longrightarrow> child \<in> set children \<Longrightarrow> cast child \<in> set nodes
                           \<Longrightarrow> parent \<in> set nodes"
   assumes to_tree_order_ptr_in_result:
     "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<Longrightarrow> ptr \<in> set nodes"
   assumes to_tree_order_parent:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent \<Longrightarrow> parent \<in> set nodes
                           \<Longrightarrow> cast child \<in> set nodes"
   assumes to_tree_order_subset:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<Longrightarrow> node \<in> set nodes
                           \<Longrightarrow> h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> set nodes' \<subseteq> set nodes"
 
 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"
   using instances
   apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def)[1]
   using to_tree_order_ok
            apply blast
   using to_tree_order_ptrs_in_heap
           apply blast
   using to_tree_order_parent_child_rel
          apply(blast, blast)
   using to_tree_order_child2
        apply blast
   using to_tree_order_node_ptrs
       apply blast
   using to_tree_order_child
      apply blast
   using to_tree_order_ptr_in_result
     apply blast
   using to_tree_order_parent
    apply blast
   using to_tree_order_subset
   apply blast
   done
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 locale l_to_tree_order_wf_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
   + l_to_tree_order_wf
 begin
 lemma to_tree_order_get_root_node:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   assumes "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
   assumes "ptr'' \<in> set to"
   shows "h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
 proof -
   obtain ancestors' where ancestors': "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
     by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E
         to_tree_order_ptrs_in_heap )
   moreover have "ptr \<in> set ancestors'"
     using \<open>h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'\<close>
     using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel
       to_tree_order_parent_child_rel by blast
 
   ultimately have "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr"
     using \<open>h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr\<close>
     using assms(1) assms(2) assms(3) get_ancestors_ptr get_ancestors_same_root_node by blast
 
   obtain ancestors'' where ancestors'': "h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''"
     by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E
         to_tree_order_ptrs_in_heap)
   moreover have "ptr \<in> set ancestors''"
     using \<open>h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''\<close>
     using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel
       to_tree_order_parent_child_rel by blast
   ultimately show ?thesis
     using \<open>h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr\<close> assms(1) assms(2) assms(3) get_ancestors_ptr
       get_ancestors_same_root_node by blast
 qed
 
 lemma to_tree_order_same_root:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr"
   assumes "h \<turnstile> to_tree_order root_ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   shows "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
 proof (insert assms(1)(*  assms(4) assms(5) *) assms(6), induct ptr' rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
   proof (cases "h \<turnstile> get_root_node child \<rightarrow>\<^sub>r child")
     case True
     then have "child = root_ptr"
       using  assms(1) assms(2) assms(3) assms(5) step.prems
       by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3
           option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs)
     then show ?thesis
       using True by blast
   next
     case False
     then obtain child_node parent where "cast child_node = child"
       and "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
       by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent
           local.get_root_node_not_node_same local.get_root_node_same_no_parent
           local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3
           step.prems)
     then show ?thesis
     proof (cases "child = root_ptr")
       case True
       then have "h \<turnstile> get_root_node root_ptr \<rightarrow>\<^sub>r root_ptr"
         using assms(4)
         using \<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 child_node = child\<close> assms(1) assms(2) assms(3)
           get_root_node_no_parent get_root_node_same_no_parent
         by blast
       then show ?thesis
         using step assms(4)
         using True by blast
     next
       case False
       then have "parent \<in> set to"
         using assms(5) step(2) to_tree_order_child \<open>h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent\<close>
           \<open>cast child_node = child\<close>
         by (metis False assms(1) assms(2) assms(3) get_parent_child_dual)
       then show ?thesis
         using \<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 child_node = child\<close> \<open>h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent\<close>
           get_root_node_parent_same
         using step.hyps by blast
     qed
 
   qed
 qed
 end
 
 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
   using instances
   by(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)
 
 locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs
   + l_get_root_node_defs + l_heap_is_wellformed_defs +
   assumes to_tree_order_get_root_node:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> ptr' \<in> set to \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr
                           \<Longrightarrow> ptr'' \<in> set to \<Longrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
   assumes to_tree_order_same_root:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr
                           \<Longrightarrow> h \<turnstile> to_tree_order root_ptr \<rightarrow>\<^sub>r to \<Longrightarrow> ptr' \<in> set to
                           \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
 
 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 type_wf known_ptr known_ptrs to_tree_order
                                        get_root_node heap_is_wellformed"
   using instances
   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)[1]
   using to_tree_order_get_root_node apply blast
   using to_tree_order_same_root apply blast
   done
 
 
 subsection \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_known_ptrs
   + l_heap_is_wellformed
   + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_get_ancestors
   + l_get_ancestors_wf
   + l_get_parent
   + l_get_parent_wf
   + l_get_root_node_wf
   + l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 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 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
   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 (metis (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3)
         disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent
         local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms
         returns_result_select_result select_result_I2 type_wf)
 
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     using heap_is_wellformed_children_disc_nodes_different child_parent_dual assms
     using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok
       returns_result_select_result split_option_ex
     by (metis (no_types, lifting))
 
   then have 4: "h \<turnstile> get_root_node (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using 2 get_root_node_no_parent
     by blast
   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 unfolding heap_is_wellformed_def
     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 eq: "\<And>document_ptr. document_ptr |\<in>| document_ptr_kinds h
            \<Longrightarrow> node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r \<longleftrightarrow> |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"
     apply(auto dest!: get_disconnected_nodes_ok[OF type_wf]
         intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1]
     apply(drule select_result_E[where P=id, simplified])
     by(auto elim!: bind_returns_result_E2)
 
   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]
     using eq
     using local.get_disconnected_nodes_ok apply auto[1]
     using assms(2) assms(3)
       apply(auto intro!: intro!: select_result_I[where P=id, simplified]
         elim!: bind_returns_result_E2)[1]
     using returns_result_eq apply fastforce
     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
     unfolding heap_is_wellformed_def
     by(auto intro: bind_pure_I bind_is_OK_I2)
 
   with 4 document_ptrs have "h \<turnstile> 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: 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)[1]
   moreover have "known_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)"
     using "4" assms(1)  known_ptrs type_wf known_ptrs_known_ptr "2" node_ptr_kinds_commutes by blast
   ultimately show ?thesis
     using 2
     apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, (rule conjI | rule impI)+)+
        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 split: option.splits intro!: bind_pure_returns_result_I)
 qed
 
 lemma in_disconnected_nodes_no_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     and "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document"
     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 -
   have 2: "cast node_ptr |\<in>| object_ptr_kinds h"
     using assms(3) get_owner_document_ptr_in_heap by fast
   then have 3: "h \<turnstile> get_root_node (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using assms(2) local.get_root_node_no_parent by blast
 
   have "\<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)"
     apply(auto)[1]
     using assms(2) child_parent_dual[OF assms(1)] type_wf
       assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3)
       returns_result_eq returns_result_select_result
     by (metis (no_types, opaque_lifting))
   moreover have "node_ptr |\<in>| node_ptr_kinds h"
     using assms(2) get_parent_ptr_in_heap by blast
   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 (metis DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) finite_set_in heap_is_wellformed_children_disc_nodes)
   then  obtain document_ptr where
     document_ptr: "document_ptr\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r" and
     node_ptr_in_disc_nodes: "node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     by auto
   then show ?thesis
     using get_owner_document_disconnected_nodes known_ptrs type_wf assms
     using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok
       returns_result_select_result select_result_I2
     by (metis (no_types, opaque_lifting) )
 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)[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>_. (local.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: 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>_. (local.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 obtain root where
     root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     by(auto simp add: 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 4 5 root
       apply(auto simp add: 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 "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast
   next
     case False
     have "known_ptr root"
       using "0" "1" "2" 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 "0" "1" "2" local.get_root_node_root_in_heap
       by blast
     then have "is_node_ptr_kind root"
       using False \<open>known_ptr root\<close>
       apply(simp add: known_ptr_impl 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)"
       by (metis (no_types, lifting) "0" "1" "2" \<open>root |\<in>| object_ptr_kinds h\<close> 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 notin_fset
           option.distinct(1) returns_result_eq returns_result_select_result root)
     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) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
           is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset
           return_ok return_pure sorted_list_of_set(1))
     then have "some_owner_document \<in> set candidates"
       apply(rule filter_M_in_result_if_ok)
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
        apply (simp add: \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>)
       using "1" \<open>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 |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         local.get_disconnected_nodes_ok by auto
     then have "candidates \<noteq> []"
       by auto
     then have "owner_document \<in> set candidates"
       using 5 root 4
       apply(auto simp add: 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
 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>_. (local.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 obtain root where
     root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     by(auto simp add: 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 3 4 root
       apply(auto simp add: 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 "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast
   next
     case False
     have "known_ptr root"
       using "0" "1" "2" 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 "0" "1" "2" local.get_root_node_root_in_heap
       by blast
     then have "is_node_ptr_kind root"
       using False \<open>known_ptr root\<close>
       apply(simp add: known_ptr_impl 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)"
       by (metis (no_types, lifting) "0" "1" "2" \<open>root |\<in>| object_ptr_kinds h\<close>
           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 notin_fset option.distinct(1) returns_result_eq
           returns_result_select_result root)
     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) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
           is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset
           return_ok return_pure sorted_list_of_set(1))
     then have "some_owner_document \<in> set candidates"
       apply(rule filter_M_in_result_if_ok)
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
        apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
       apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
       by (simp add: "1" local.get_disconnected_nodes_ok)
 
     then have "candidates \<noteq> []"
       by auto
     then have "owner_document \<in> set candidates"
       using 4 root 3
       apply(auto simp add: 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_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)[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_element_ptr
        apply blast
     using assms(4)
       apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
       apply (metis (no_types, lifting) document_ptr_casts_commute3 document_ptr_kinds_commutes
         is_document_ptr_kind_none option.case_eq_if)
     using assms(4)
      apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
       apply (metis (no_types, lifting) assms(1) assms(2) assms(3) is_node_ptr_kind_none
         local.get_root_node_ok node_ptr_casts_commute3 option.case_eq_if)
     using assms(4)
      apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
      apply(auto split: option.splits
         intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1]
     using assms(3) local.get_disconnected_nodes_ok
      apply blast
     apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok)
     using assms(4)
     apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
      apply(auto split: option.splits
         intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1]
      apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok)[1]
     apply(auto split: option.splits
         intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1]
     using assms(3) local.get_disconnected_nodes_ok by blast
 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
 
   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> 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> 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> 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:  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>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 known_ptr_impl)[1]
        apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
           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>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 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>
       by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs
           split: option.splits)
     then have "h \<turnstile> 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> 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 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 known_ptr_impl)[1]
        apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
           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
          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
         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
        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
       apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
       apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
          apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
          apply (meson invoke_empty is_OK_returns_result_I)
         apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
        apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
       by(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
   qed
   then show ?thesis
     using \<open>known_ptr (cast child)\<close>
     apply(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 known_ptr_impl)[1]
      apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
         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>
        apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
      apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
     apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     by (smt \<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 child |\<in>| object_ptr_kinds h\<close> cast_document_ptr_not_node_ptr(1)
         comp_apply invoke_empty invoke_not invoke_returns_result is_OK_returns_result_I
         node_ptr_casts_commute2 option.sel)
 qed
 
 end
 
 locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_get_disconnected_nodes_defs + l_get_owner_document_defs
   + l_get_parent_defs +
   assumes get_owner_document_disconnected_nodes:
     "heap_is_wellformed h \<Longrightarrow>
      known_ptrs h \<Longrightarrow>
      type_wf h \<Longrightarrow>
      h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
      node_ptr \<in> set disc_nodes \<Longrightarrow>
      h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r document_ptr"
   assumes in_disconnected_nodes_no_parent:
     "heap_is_wellformed h \<Longrightarrow>
     h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None\<Longrightarrow>
     h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document \<Longrightarrow>
     h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
     known_ptrs h \<Longrightarrow>
     type_wf h\<Longrightarrow>
     node_ptr \<in> set disc_nodes"
   assumes get_owner_document_owner_document_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow>
 h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<Longrightarrow>
 owner_document |\<in>| document_ptr_kinds h"
   assumes get_owner_document_ok:
     "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h
                           \<Longrightarrow> h \<turnstile> ok (get_owner_document ptr)"
 
 interpretation i_get_owner_document_wf?: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr known_ptrs type_wf 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 get_owner_document
   by(auto simp add: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def)[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>get\_root\_node\<close>
 
 locale l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf
 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)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
          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: 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_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)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
          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: 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)[2]
   }
   ultimately
   show ?thesis
     using \<open>known_ptr ptr\<close>
     by(auto simp add: known_ptr_impl 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 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> local.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)[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
         have "is_document_ptr root"
           using True \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl 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)[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>
           by(auto simp add: 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)
 
       next
         case False
         then have "is_node_ptr_kind root"
           using \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl 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> local.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> local.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: 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)[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 DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)[1]
             apply(auto simp add: known_ptr_impl 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)[1]
           apply(split invoke_splits)+
              apply (meson invoke_empty is_OK_returns_result_I)
             apply(auto simp add: True 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)[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 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> local.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)[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> local.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: 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)[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 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 get_owner_document_wf_get_root_node_wf?: l_get_owner_document_wf_get_root_node_wf\<^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 heap_is_wellformed parent_child_rel
   get_disconnected_nodes get_disconnected_nodes_locs get_owner_document
   by(auto simp add: l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_owner_document_wf_get_root_node_wf = l_heap_is_wellformed_defs + l_type_wf +
   l_known_ptrs + l_get_root_node_defs + l_get_owner_document_defs +
   assumes get_root_node_document:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow>
 is_document_ptr_kind root \<Longrightarrow> h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r the (cast root)"
   assumes get_root_node_same_owner_document:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow>
 h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow> h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
 
 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
 
 
 subsection \<open>Preserving heap-wellformedness\<close>
 
 subsection \<open>set\_attribute\<close>
 
 locale l_set_attribute_wf\<^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 +
   l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_attribute_get_disconnected_nodes +
   l_set_attribute_get_child_nodes
 begin
 lemma set_attribute_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> set_attribute element_ptr k v \<rightarrow>\<^sub>h h'"
   shows "heap_is_wellformed h'"
   thm preserves_wellformedness_writes_needed
   apply(rule preserves_wellformedness_writes_needed[OF assms set_attribute_writes])
   using  set_attribute_get_child_nodes
     apply(fast)
   using set_attribute_get_disconnected_nodes apply(fast)
   by(auto simp add: all_args_def set_attribute_locs_def)
 end
 
 
 subsection \<open>remove\_child\<close>
 
 locale l_remove_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed +
   l_set_disconnected_nodes_get_child_nodes
 begin
 lemma remove_child_removes_parent:
   assumes wellformed: "heap_is_wellformed h"
     and remove_child: "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h2"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h2 \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
 proof -
   obtain children where children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     using remove_child remove_child_def by auto
   then have "child \<in> set children"
     using remove_child remove_child_def
     by(auto elim!: bind_returns_heap_E dest: returns_result_eq split: if_splits)
   then have h1: "\<And>other_ptr other_children. other_ptr \<noteq> ptr
                 \<Longrightarrow> h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
     using assms(1) known_ptrs  type_wf child_parent_dual
     by (meson child_parent_dual children option.inject returns_result_eq)
 
   have known_ptr: "known_ptr ptr"
     using known_ptrs
     by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms
         remove_child remove_child_ptr_in_heap)
 
   obtain owner_document disc_nodes h' where
     owner_document: "h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r owner_document" and
     disc_nodes: "h \<turnstile>  get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h': "h \<turnstile>  set_disconnected_nodes owner_document (child # disc_nodes) \<rightarrow>\<^sub>h h'" and
     h2: "h' \<turnstile> set_child_nodes ptr (remove1 child children) \<rightarrow>\<^sub>h h2"
     using assms children unfolding remove_child_def
     apply(auto split: if_splits elim!: bind_returns_heap_E)[1]
     by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure
         get_owner_document_pure pure_returns_heap_eq returns_result_eq)
 
   have "object_ptr_kinds h = object_ptr_kinds h2"
     using remove_child_writes remove_child unfolding remove_child_locs_def
     apply(rule writes_small_big)
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by(auto simp add: reflp_def transp_def)
   then have "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
     unfolding object_ptr_kinds_M_defs by simp
 
   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 type_wf
     by(auto simp add: reflp_def transp_def)
   have "type_wf h2"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'",
         OF remove_child_writes remove_child]  unfolding remove_child_locs_def
     using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf
     apply(auto simp add: reflp_def transp_def)[1]
     by blast
   then obtain children' where children': "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'"
     using h2 set_child_nodes_get_child_nodes known_ptr
     by (metis \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> children get_child_nodes_ok
         get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I)
 
   have "child \<notin> set children'"
     by (metis (mono_tags, lifting) \<open>type_wf h'\<close> children children' distinct_remove1_removeAll h2
         known_ptr local.heap_is_wellformed_children_distinct
         local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2
         wellformed)
 
 
   moreover have "\<And>other_ptr other_children. other_ptr \<noteq> ptr
                 \<Longrightarrow> h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
   proof -
     fix other_ptr other_children
     assume a1: "other_ptr \<noteq> ptr"  and a3: "h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
     have "h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
       using get_child_nodes_reads set_disconnected_nodes_writes h' a3
       apply(rule reads_writes_separate_backwards)
       using set_disconnected_nodes_get_child_nodes by fast
     show "child \<notin> set other_children"
       using \<open>h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children\<close> a1 h1 by blast
   qed
   then have "\<And>other_ptr other_children. other_ptr \<noteq> ptr
             \<Longrightarrow>  h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
   proof -
     fix other_ptr other_children
     assume a1: "other_ptr \<noteq> ptr" and a3: "h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
     have "h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
       using get_child_nodes_reads set_child_nodes_writes h2 a3
       apply(rule reads_writes_separate_backwards)
       using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers
       by metis
     then show "child \<notin> set other_children"
       using \<open>\<And>other_ptr other_children. \<lbrakk>other_ptr \<noteq> ptr; h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children\<rbrakk>
              \<Longrightarrow> child \<notin> set other_children\<close> a1 by blast
   qed
   ultimately have ha: "\<And>other_ptr other_children. h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children
                       \<Longrightarrow> child \<notin> set other_children"
     by (metis (full_types) children' returns_result_eq)
   moreover obtain ptrs where ptrs: "h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by (simp add: object_ptr_kinds_M_defs)
   moreover have "\<And>ptr. ptr \<in> set ptrs \<Longrightarrow> h2 \<turnstile> ok (get_child_nodes ptr)"
     using \<open>type_wf h2\<close> ptrs get_child_nodes_ok known_ptr
     using \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> known_ptrs local.known_ptrs_known_ptr by auto
   ultimately show "h2 \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
     apply(auto simp add: get_parent_def intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I)[1]
   proof -
     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 child |\<in>| object_ptr_kinds h"
       using get_owner_document_ptr_in_heap owner_document by blast
     then show "h2 \<turnstile> check_in_heap (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 ()"
       by (simp add: \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> check_in_heap_def)
   next
     show "(\<And>other_ptr other_children. h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children
          \<Longrightarrow> child \<notin> set other_children) \<Longrightarrow>
     ptrs = sorted_list_of_set (fset (object_ptr_kinds h2)) \<Longrightarrow>
     (\<And>ptr. ptr |\<in>| object_ptr_kinds h2 \<Longrightarrow> h2 \<turnstile> ok get_child_nodes ptr) \<Longrightarrow>
     h2 \<turnstile> filter_M (\<lambda>ptr. Heap_Error_Monad.bind (get_child_nodes ptr)
        (\<lambda>children. return (child \<in> set children))) (sorted_list_of_set (fset (object_ptr_kinds h2))) \<rightarrow>\<^sub>r []"
       by(auto intro!: filter_M_empty_I bind_pure_I)
   qed
 qed
 end
 
 locale l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_remove_child_wf\<^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
 begin
 
 lemma remove_child_parent_child_rel_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "parent_child_rel h' \<subseteq> parent_child_rel h"
 proof (standard, safe)
 
   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(2)
     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 object_ptr_kinds_eq3: "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(2)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_eq: "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     using node_ptr_kinds_M_eq by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     using document_ptr_kinds_M_eq by auto
   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(2)])
     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 disconnected_nodes_eq:
     "\<And>document_ptr disconnected_nodes. document_ptr \<noteq> owner_document
        \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
          = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)])
     unfolding remove_child_locs_def
     using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers
     by (metis (no_types, lifting) Un_iff owner_document select_result_I2)
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. document_ptr \<noteq> owner_document
        \<Longrightarrow> |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes document_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 "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 type_wf
     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_child_nodes_writes h']
     using  set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r remove1 child children_h"
     using assms(2) 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
 
   fix parent child
   assume a1: "(parent, child) \<in> parent_child_rel h'"
   then show "(parent, child) \<in> parent_child_rel h"
   proof (cases "parent = ptr")
     case True
     then show ?thesis
       using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h'
         get_child_nodes_ptr_in_heap
       apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1]
       by (metis notin_set_remove1)
   next
     case False
     then show ?thesis
       using a1
       by(auto simp add: parent_child_rel_def object_ptr_kinds_eq3 children_eq2)
   qed
 qed
 
 
 lemma remove_child_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "type_wf h'" and "known_ptrs h'" and "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(2)
     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 object_ptr_kinds_eq3: "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(2)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_eq: "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     using node_ptr_kinds_M_eq by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     using document_ptr_kinds_M_eq by auto
   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(2)])
     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 disconnected_nodes_eq: "\<And>document_ptr disconnected_nodes. document_ptr \<noteq> owner_document
          \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
              = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)])
     unfolding remove_child_locs_def
     using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers
     by (metis (no_types, lifting) Un_iff owner_document select_result_I2)
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. document_ptr \<noteq> owner_document
     \<Longrightarrow> |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes document_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)
 
   show "known_ptrs h'"
     using object_ptr_kinds_eq3 known_ptrs_preserved \<open>known_ptrs h\<close> by blast
 
   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 type_wf
     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_child_nodes_writes h']
     using  set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r remove1 child children_h"
     using assms(2) 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_h2: "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     using owner_document assms(2) h2 disconnected_nodes_h
     apply (auto simp add: remove_child_def  split: if_splits)[1]
     apply(drule bind_returns_heap_E2)
       apply(auto split: if_splits)[1]
      apply(simp)
     by(auto simp add: local.set_disconnected_nodes_get_disconnected_nodes split: if_splits)
   then have disconnected_nodes_h': "h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     apply(rule reads_writes_separate_forwards[OF get_disconnected_nodes_reads set_child_nodes_writes h'])
     by (simp add: set_child_nodes_get_disconnected_nodes)
 
   moreover have "a_acyclic_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
   proof (standard, safe)
     fix parent child
     assume a1: "(parent, child) \<in> parent_child_rel h'"
     then show "(parent, child) \<in> parent_child_rel h"
     proof (cases "parent = ptr")
       case True
       then show ?thesis
         using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h'
           get_child_nodes_ptr_in_heap
         apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1]
         by (metis imageI notin_set_remove1)
     next
       case False
       then show ?thesis
         using a1
         by(auto simp add: parent_child_rel_def object_ptr_kinds_eq3 children_eq2)
     qed
   qed
   then have "a_acyclic_heap h'"
     using \<open>a_acyclic_heap h\<close> acyclic_heap_def acyclic_subset by blast
 
   moreover have "a_all_ptrs_in_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3 disconnected_nodes_eq)[1]
      apply (metis (no_types, lifting) \<open>type_wf h'\<close> assms(2) assms(3) local.get_child_nodes_ok
         local.known_ptrs_known_ptr local.remove_child_children_subset notin_fset object_ptr_kinds_eq3
         returns_result_select_result subset_code(1) type_wf)
     apply (metis (no_types, lifting) assms(2) disconnected_nodes_eq2 disconnected_nodes_h
         disconnected_nodes_h' document_ptr_kinds_eq3 finite_set_in local.remove_child_child_in_heap
         node_ptr_kinds_eq3 select_result_I2 set_ConsD subset_code(1))
     done
   moreover have "a_owner_document_valid h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3
         node_ptr_kinds_eq3)[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 h' \<and> node_ptr \<in> set |h \<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 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"
     proof (cases "node_ptr = child")
       case True
       show ?thesis
         apply(rule exI[where x=owner_document])
         using children_eq2 disconnected_nodes_eq2 children_h children_h' disconnected_nodes_h' True
         by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I
             list.set_intros(1) select_result_I2)
     next
       case False
       then show ?thesis
         using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h
           disconnected_nodes_h'
         apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1]
         by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2))
     qed
   qed
 
   moreover
   {
     have h0: "a_distinct_lists h"
       using assms(1)  by (simp add: heap_is_wellformed_def)
     moreover have ha1: "(\<Union>x\<in>set |h \<turnstile> object_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_child_nodes x|\<^sub>r)
                  \<inter> (\<Union>x\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       using \<open>a_distinct_lists h\<close>
       unfolding a_distinct_lists_def
       by(auto)
     have ha2: "ptr |\<in>| object_ptr_kinds h"
       using children_h get_child_nodes_ptr_in_heap by blast
     have ha3: "child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r"
       using child_in_children_h children_h
       by(simp)
     have child_not_in: "\<And>document_ptr. document_ptr |\<in>| document_ptr_kinds h
                           \<Longrightarrow> child \<notin> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
       using ha1 ha2 ha3
       apply(simp)
       using IntI by fastforce
     moreover have "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: object_ptr_kinds_M_defs)
     moreover have "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: document_ptr_kinds_M_defs)
     ultimately have "a_distinct_lists h'"
     proof(simp (no_asm) add: a_distinct_lists_def, safe)
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
 
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       have 4: "distinct (concat ((map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)))"
         using 1 by(auto simp add: a_distinct_lists_def)
       show "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                      (sorted_list_of_set (fset (object_ptr_kinds h')))))"
       proof(rule distinct_concat_map_I[OF 3[unfolded object_ptr_kinds_eq2], simplified])
         fix x
         assume 5: "x |\<in>| object_ptr_kinds h'"
         then have 6: "distinct |h \<turnstile> get_child_nodes x|\<^sub>r"
           using 4 distinct_concat_map_E object_ptr_kinds_eq2 by fastforce
         obtain children where children: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children"
           and distinct_children: "distinct children"
           by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr
               object_ptr_kinds_eq3 select_result_I)
         obtain children' where children': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children'"
           using children children_eq children_h' by fastforce
         then have "distinct children'"
         proof (cases "ptr = x")
           case True
           then show ?thesis
             using children distinct_children children_h children_h'
             by (metis children' distinct_remove1 returns_result_eq)
         next
           case False
           then show ?thesis
             using children distinct_children children_eq[OF False]
             using children' distinct_lists_children h0
             using select_result_I2 by fastforce
         qed
 
         then show "distinct |h' \<turnstile> get_child_nodes x|\<^sub>r"
           using children' by(auto simp add: )
       next
         fix x y
         assume 5: "x |\<in>| object_ptr_kinds h'" and 6: "y |\<in>| object_ptr_kinds h'" and 7: "x \<noteq> y"
         obtain children_x where children_x: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x"
           by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_y where children_y: "h \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y"
           by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_x' where children_x': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x'"
           using children_eq children_h' children_x by fastforce
         obtain children_y' where children_y': "h' \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y'"
           using children_eq children_h' children_y by fastforce
         have "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r))"
           using h0 by(auto simp add: a_distinct_lists_def)
         then have 8: "set children_x \<inter> set children_y = {}"
           using "7" assms(1) children_x children_y local.heap_is_wellformed_one_parent by blast
         have "set children_x' \<inter> set children_y' = {}"
         proof (cases "ptr = x")
           case True
           then have "ptr \<noteq> y"
             by(simp add: 7)
           have "children_x' = remove1 child children_x"
             using children_h children_h' children_x children_x' True returns_result_eq by fastforce
           moreover have "children_y' = children_y"
             using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
           ultimately show ?thesis
             using 8 set_remove1_subset by fastforce
         next
           case False
           then show ?thesis
           proof (cases "ptr = y")
             case True
             have "children_y' = remove1 child children_y"
               using children_h children_h' children_y children_y' True returns_result_eq by fastforce
             moreover have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             ultimately show ?thesis
               using 8 set_remove1_subset by fastforce
           next
             case False
             have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             moreover have "children_y' = children_y"
               using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
             ultimately show ?thesis
               using 8 by simp
           qed
         qed
         then show "set |h' \<turnstile> get_child_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_child_nodes y|\<^sub>r = {}"
           using children_x' children_y'
           by (metis (no_types, lifting) select_result_I2)
       qed
     next
       assume 2: "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       then have 4: "distinct  (sorted_list_of_set (fset (document_ptr_kinds h')))"
         by simp
       have 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')))))"
         using h0
         by(simp add: a_distinct_lists_def document_ptr_kinds_eq3)
 
       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[OF 4[unfolded document_ptr_kinds_eq3]])
         fix x
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
         have 5: "distinct |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
           using distinct_lists_disconnected_nodes[OF h0] 4 get_disconnected_nodes_ok
           by (simp add: type_wf document_ptr_kinds_eq3 select_result_I)
         show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
         proof (cases "x = owner_document")
           case True
           have "child \<notin> set |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using child_not_in  document_ptr_kinds_eq2 "4" by fastforce
           moreover have "|h' \<turnstile> get_disconnected_nodes x|\<^sub>r = child # |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using disconnected_nodes_h' disconnected_nodes_h unfolding True
             by(simp)
           ultimately show ?thesis
             using 5 unfolding True
             by simp
         next
           case False
           show ?thesis
             using "5" False disconnected_nodes_eq2 by auto
         qed
       next
         fix x y
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
           and 5: "y \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))" and "x \<noteq> y"
         obtain disc_nodes_x where disc_nodes_x: "h \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y where disc_nodes_y: "h \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of y] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_x' where disc_nodes_x': "h' \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x'"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y' where disc_nodes_y': "h' \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y'"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of y] document_ptr_kinds_eq2
           by auto
         have "distinct
                (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
           using h0 by (simp add: a_distinct_lists_def)
         then have 6: "set disc_nodes_x \<inter> set disc_nodes_y = {}"
           using \<open>x \<noteq> y\<close> assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent
           by blast
 
         have "set disc_nodes_x' \<inter> set disc_nodes_y' = {}"
         proof (cases "x = owner_document")
           case True
           then have "y \<noteq> owner_document"
             using \<open>x \<noteq> y\<close> by simp
           then have "disc_nodes_y' = disc_nodes_y"
             using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y'
             by auto
           have "disc_nodes_x' = child # disc_nodes_x"
             using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h
               returns_result_eq
             by fastforce
           have "child \<notin> set disc_nodes_y"
             using child_not_in  disc_nodes_y 5
             using document_ptr_kinds_eq2  by fastforce
           then show ?thesis
             apply(unfold \<open>disc_nodes_x' = child # disc_nodes_x\<close> \<open>disc_nodes_y' = disc_nodes_y\<close>)
             using 6 by auto
         next
           case False
           then show ?thesis
           proof (cases "y = owner_document")
             case True
             then have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x'
               by auto
             have "disc_nodes_y' = child # disc_nodes_y"
               using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h
                 returns_result_eq
               by fastforce
             have "child \<notin> set disc_nodes_x"
               using child_not_in  disc_nodes_x 4
               using document_ptr_kinds_eq2  by fastforce
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = child # disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           next
             case False
             have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x'
               by auto
             have "disc_nodes_y' = disc_nodes_y"
               using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y'
               by auto
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           qed
         qed
         then show "set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
           using disc_nodes_x' disc_nodes_y' by auto
       qed
     next
       fix x xa xb
       assume 1: "xa \<in> fset (object_ptr_kinds h')"
         and 2: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 3: "xb \<in> fset (document_ptr_kinds h')"
         and 4: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       obtain disc_nodes where disc_nodes: "h \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of xb] document_ptr_kinds_eq2 by auto
       obtain disc_nodes' where disc_nodes': "h' \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes'"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of xb]  document_ptr_kinds_eq2 by auto
 
       obtain children where children: "h \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children"
         by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E
             local.known_ptrs_known_ptr object_ptr_kinds_eq3)
       obtain children' where children': "h' \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children'"
         using children children_eq children_h' by fastforce
       have "\<And>x. x \<in> set |h \<turnstile> get_child_nodes xa|\<^sub>r \<Longrightarrow> x \<in> set |h \<turnstile> get_disconnected_nodes xb|\<^sub>r \<Longrightarrow> False"
         using 1 3
         apply(fold \<open> object_ptr_kinds h =  object_ptr_kinds h'\<close>)
         apply(fold \<open> document_ptr_kinds h =  document_ptr_kinds h'\<close>)
         using children disc_nodes h0 apply(auto simp add: a_distinct_lists_def)[1]
         by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2)
       then have 5: "\<And>x. x \<in> set children \<Longrightarrow> x \<in> set disc_nodes \<Longrightarrow> False"
         using children disc_nodes  by fastforce
       have 6: "|h' \<turnstile> get_child_nodes xa|\<^sub>r = children'"
         using children' by simp
       have 7: "|h' \<turnstile> get_disconnected_nodes xb|\<^sub>r = disc_nodes'"
         using disc_nodes' by simp
       have "False"
       proof (cases "xa = ptr")
         case True
         have "distinct children_h"
           using children_h distinct_lists_children h0 \<open>known_ptr ptr\<close> by blast
         have "|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h"
           using children_h'
-          bysimp
+          by simp
         have "children = children_h"
           using True children children_h by auto
         show ?thesis
           using disc_nodes' children' 5 2 4 children_h \<open>distinct children_h\<close> disconnected_nodes_h'
           apply(auto simp add: 6 7
               \<open>xa = ptr\<close> \<open>|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h\<close> \<open>children = children_h\<close>)[1]
           by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h
               select_result_I2 set_ConsD)
       next
         case False
         have "children' = children"
           using children' children children_eq[OF False[symmetric]]
           by auto
         then show ?thesis
         proof (cases "xb = owner_document")
           case True
           then show ?thesis
             using disc_nodes disconnected_nodes_h disconnected_nodes_h'
             using "2" "4" "5" "6" "7" False \<open>children' = children\<close> assms(1) child_in_children_h
               child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap
               list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD
             by (metis (no_types, opaque_lifting) assms(3) type_wf)
         next
           case False
           then show ?thesis
             using "2" "4" "5" "6" "7" \<open>children' = children\<close> disc_nodes disc_nodes'
               disconnected_nodes_eq returns_result_eq
             by metis
         qed
       qed
       then show "x \<in> {}"
         by simp
     qed
   }
 
   ultimately show "heap_is_wellformed h'"
     using heap_is_wellformed_def by blast
 qed
 
 lemma remove_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
   using assms
   by(auto simp add: remove_def intro: remove_child_heap_is_wellformed_preserved
       elim!: bind_returns_heap_E2 split: option.splits)
 
 lemma remove_child_removes_child:
   assumes wellformed: "heap_is_wellformed h"
     and remove_child: "h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'"
     and children: "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "child \<notin> set children"
 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(2)
     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 "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 remove_child])
     unfolding remove_child_locs_def
     using set_child_nodes_pointers_preserved set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   moreover have "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF remove_child_writes assms(2)]
     using set_child_nodes_types_preserved set_disconnected_nodes_types_preserved type_wf
     unfolding remove_child_locs_def
     apply(auto simp add: reflp_def transp_def)[1]
     by blast
   ultimately show ?thesis
     using remove_child_removes_parent remove_child_heap_is_wellformed_preserved child_parent_dual
     by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child
         returns_result_eq type_wf wellformed)
 qed
 
 lemma remove_child_removes_first_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
   assumes "h \<turnstile> remove_child ptr node_ptr \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
 proof -
   obtain h2 disc_nodes owner_document where
     "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document" and
     "h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h2: "h \<turnstile> set_disconnected_nodes owner_document (node_ptr # disc_nodes) \<rightarrow>\<^sub>h h2" and
     "h2 \<turnstile> set_child_nodes ptr children \<rightarrow>\<^sub>h h'"
     using assms(5)
     apply(auto simp add: remove_child_def
         dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1]
     by(auto elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])
   have "known_ptr ptr"
     by (meson assms(3) assms(4) is_OK_returns_result_I get_child_nodes_ptr_in_heap known_ptrs_known_ptr)
   moreover have "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
     apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 assms(4)])
     using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers
     by fast
   moreover 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 \<open>type_wf h\<close> set_disconnected_nodes_types_preserved
     by(auto simp add:  reflp_def transp_def)
   ultimately show ?thesis
     using set_child_nodes_get_child_nodes\<open>h2 \<turnstile> set_child_nodes ptr children \<rightarrow>\<^sub>h h'\<close>
     by fast
 qed
 
 lemma remove_removes_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
   assumes "h \<turnstile> remove node_ptr \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
 proof -
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r Some ptr"
     using child_parent_dual assms by fastforce
   show ?thesis
     using assms remove_child_removes_first_child
     by(auto simp add: remove_def
         dest!: bind_returns_heap_E3[rotated, OF \<open>h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r Some ptr\<close>, rotated]
         bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])
 qed
 
 lemma remove_for_all_empty_children:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "h \<turnstile> forall_M remove children \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
   using assms
 proof(induct children arbitrary: h h')
   case Nil
   then show ?case
     by simp
 next
   case (Cons a children)
   have "h \<turnstile> get_parent a \<rightarrow>\<^sub>r Some ptr"
     using child_parent_dual Cons by fastforce
   with Cons show ?case
   proof(auto elim!: bind_returns_heap_E)[1]
     fix h2
     assume 0: "(\<And>h h'. 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 [])"
       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 a # children"
       and 5: "h \<turnstile> get_parent a \<rightarrow>\<^sub>r Some ptr"
       and 7: "h \<turnstile> remove a \<rightarrow>\<^sub>h h2"
       and 8: "h2 \<turnstile> forall_M remove children \<rightarrow>\<^sub>h h'"
     then have "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
       using remove_removes_child by blast
 
     moreover have "heap_is_wellformed h2"
       using 7 1 2 3 remove_child_heap_is_wellformed_preserved(3)
       by(auto simp add: remove_def
           elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
           split: option.splits)
     moreover have "type_wf h2"
       using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF remove_writes 7]
       using \<open>type_wf h\<close> remove_child_types_preserved
       by(auto simp add: a_remove_child_locs_def reflp_def transp_def)
     moreover have "object_ptr_kinds h = object_ptr_kinds h2"
       using 7
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF remove_writes])
       using remove_child_pointers_preserved
       by (auto simp add: reflp_def transp_def)
     then have "known_ptrs h2"
       using 3  known_ptrs_preserved by blast
 
     ultimately show "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
       using 0 8 by fast
   qed
 qed
 end
 
 locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_remove_defs +
   assumes remove_child_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes remove_child_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes remove_child_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
   assumes remove_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes remove_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes remove_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
   assumes 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"
   assumes 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"
   assumes 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"
   assumes 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 []"
 
 interpretation i_remove_child_wf2?: 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 parent_child_rel
   by unfold_locales
 
 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_heap_is_wellformed_preserved apply(fast, fast, fast)
   using remove_heap_is_wellformed_preserved apply(fast, fast, 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
 
 
 
 subsection \<open>adopt\_node\<close>
 
 locale 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 +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_heap_is_wellformed
 begin
 lemma adopt_node_removes_first_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h'"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r node # children"
   shows "h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
 proof -
   obtain old_document parent_opt h2 where
     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
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node }
                                | None \<Rightarrow> do { 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 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 h'"
     using assms(4)
     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 "h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h2 remove_child_removes_first_child assms(1) assms(2) assms(3) assms(5)
     by (metis list.set_intros(1) local.child_parent_dual option.simps(5) parent_opt returns_result_eq)
   then
   show ?thesis
     using h'
     by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]
         split: if_splits)
 qed
 
 
 lemma adopt_node_document_in_heap:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> ok (adopt_node owner_document node)"
   shows "owner_document |\<in>| document_ptr_kinds h"
 proof -
   obtain old_document parent_opt h2 h' where
     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
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node } | None \<Rightarrow> do { 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 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 h'"
     using assms(4)
     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
       using old_document get_owner_document_owner_document_in_heap assms(1) assms(2) assms(3)
       by auto
   next
     case False
 
     then obtain h3 old_disc_nodes disc_nodes where
       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 node old_disc_nodes) \<rightarrow>\<^sub>h h3" and
       old_disc_nodes: "h3 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
       h': "h3 \<turnstile> set_disconnected_nodes owner_document (node # disc_nodes) \<rightarrow>\<^sub>h h'"
       using h'
       by(auto elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] )
     then have "owner_document |\<in>| document_ptr_kinds h3"
       by (meson is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap)
 
     moreover have "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)
     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_disconnected_nodes_writes h3])
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def)
 
     ultimately show ?thesis
       by(auto simp add: document_ptr_kinds_def)
   qed
 qed
 end
 
 locale l_adopt_node_wf2\<^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 +
   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 +
   l_get_root_node +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma adopt_node_removes_child_step:
   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 get_parent_pure
     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_removes_child:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'"
   shows "\<And>ptr' children'.
   h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> node_ptr \<notin> set children'"
   using adopt_node_removes_child_step assms by blast
 
 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 known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "known_ptrs h2"
     using h2 remove_child_preserves_known_ptrs known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
   proof(cases "document_ptr = old_document")
     case True
     then show ?thesis
       using h' wellformed_h2 \<open>type_wf h2\<close> \<open>known_ptrs 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 "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
 
     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 "a_owner_document_valid h"
         using assms(1) heap_is_wellformed_def by(simp add: 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 "a_distinct_lists h2"
         using 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: 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 "a_acyclic_heap h2"
       using wellformed_h2 by (simp add: 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 parent_child_rel_def
         by(simp)
     qed
     then have "a_acyclic_heap h'"
       using \<open>a_acyclic_heap h2\<close> acyclic_heap_def acyclic_subset by blast
 
     moreover have "a_all_ptrs_in_heap h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_all_ptrs_in_heap h3"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1]
        apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1))
       by (metis (no_types, lifting) \<open>child \<in> set disc_nodes_old_document_h2\<close> \<open>type_wf h2\<close>
           disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2
           document_ptr_kinds_eq3_h2 in_set_remove1 local.get_disconnected_nodes_ok
           local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 returns_result_select_result
           select_result_I2 wellformed_h2)
     then have "a_all_ptrs_in_heap h'"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1]
        apply (simp add: children_eq2_h3 object_ptr_kinds_h3_eq3 subset_code(1))
       by (metis (no_types, 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 finite_set_in
           local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           select_result_I2 set_ConsD subset_code(1) wellformed_h2)
 
     moreover have "a_owner_document_valid h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_owner_document_valid h'"
       apply(simp add: 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 (smt  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: "a_distinct_lists h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_distinct_lists h'"
       apply(auto simp add: 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 fmember.rep_eq set_sorted_list_of_set)
                 ultimately show ?thesis
                   using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr = y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3
                   by auto
               next
                 case False
                 then show ?thesis
                   using 5
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr \<noteq> y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close>
                     disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
                   by (metis \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}\<close>
                       empty_iff inf.idem)
               qed
             qed
           qed
         qed
       qed
     next
       fix x xa xb
       assume 0: "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                                   (sorted_list_of_set (fset (object_ptr_kinds h')))))"
         and 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                    (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
         and 2: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h2). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         and 3: "xa |\<in>| object_ptr_kinds h'"
         and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 5: "xb |\<in>| document_ptr_kinds h'"
         and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       then show False
         using \<open>child \<in> set disc_nodes_old_document_h2\<close> disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2
           document_ptr_kinds_eq2_h3  old_document_in_heap
         apply(auto)[1]
         apply(cases "xb = old_document")
       proof -
         assume a1: "xb = old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a3: "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 child disc_nodes_old_document_h2"
         assume a4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a5: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f6: "old_document |\<in>| document_ptr_kinds h'"
           using a1 \<open>xb |\<in>| document_ptr_kinds h'\<close> by blast
         have f7: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a2 by simp
         have "x \<in> set disc_nodes_old_document_h2"
           using f6 a3 a1 by (metis (no_types) \<open>type_wf h'\<close> \<open>x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r\<close>
               disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq
               returns_result_select_result set_remove1_subset subsetCE)
         then have "set |h' \<turnstile> get_child_nodes xa|\<^sub>r \<inter>  set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
           using f7 f6 a5 a4 \<open>xa |\<in>| object_ptr_kinds h'\<close>
           by fastforce
         then show ?thesis
           using \<open>x \<in> set disc_nodes_old_document_h2\<close> a1 a4 f7 by blast
       next
         assume a1: "xb \<noteq> old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3"
         assume a3: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a4: "xa |\<in>| object_ptr_kinds h'"
         assume a5: "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r child # disc_nodes_document_ptr_h3"
         assume a6: "old_document |\<in>| document_ptr_kinds h'"
         assume a7: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
         assume a8: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a10: "\<And>doc_ptr. old_document \<noteq> doc_ptr
                \<Longrightarrow> |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a11: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr
                \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a12: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f13: "\<And>d. d \<notin> set |h' \<turnstile> document_ptr_kinds_M|\<^sub>r \<or> h2 \<turnstile> ok get_disconnected_nodes d"
           using a9 \<open>type_wf h2\<close> get_disconnected_nodes_ok
           by simp
         then have f14: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a6 a3 by simp
         have "x \<notin> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
           using a12 a8 a4 \<open>xb |\<in>| document_ptr_kinds h'\<close>
           by (meson UN_I disjoint_iff_not_equal fmember.rep_eq)
         then have "x = child"
           using f13 a11 a10 a7 a5 a2 a1
           by (metis (no_types, lifting) select_result_I2 set_ConsD)
         then have "child \<notin> set disc_nodes_old_document_h2"
           using f14 a12 a8 a6 a4
           by (metis \<open>type_wf h'\<close> adopt_node_removes_child assms(1) assms(2) type_wf
               get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3
               object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result)
         then show ?thesis
           using \<open>child \<in> set disc_nodes_old_document_h2\<close> by fastforce
       qed
     qed
     ultimately show ?thesis
       using \<open>type_wf h'\<close> \<open>known_ptrs h'\<close> \<open>a_owner_document_valid h'\<close> heap_is_wellformed_def by blast
   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 i_adopt_node_wf?: 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 adopt_node_locs 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(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>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 heap_is_wellformed parent_child_rel get_root_node get_root_node_locs
   by(simp add: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs
   + l_get_child_nodes_defs + l_get_disconnected_nodes_defs +
   assumes adopt_node_preserves_wellformedness:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> heap_is_wellformed h'"
   assumes adopt_node_removes_child:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h2
                           \<Longrightarrow> h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> node_ptr \<notin> set children"
   assumes adopt_node_node_in_disconnected_nodes:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes
                           \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> node_ptr \<in> set disc_nodes"
   assumes 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"
   assumes 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"
   assumes adopt_node_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> type_wf h'"
   assumes adopt_node_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h'"
 
 
 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"
   using heap_is_wellformed_is_l_heap_is_wellformed known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_adopt_node_wf_def l_adopt_node_wf_axioms_def)[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
 
 
 subsection \<open>insert\_before\<close>
 
 locale l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node_wf +
   l_set_disconnected_nodes_get_child_nodes +
   l_heap_is_wellformed
 begin
 lemma insert_before_removes_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "ptr \<noteq> ptr'"
   assumes "h \<turnstile> insert_before ptr node child \<rightarrow>\<^sub>h h'"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r node # children"
   shows "h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
 proof -
   obtain owner_document h2 h3 disc_nodes reference_child where
     "h \<turnstile> (if Some node = child then a_next_sibling node else return child) \<rightarrow>\<^sub>r reference_child" and
     "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
     "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h3: "h2 \<turnstile> set_disconnected_nodes owner_document (remove1 node disc_nodes) \<rightarrow>\<^sub>h h3" and
     h': "h3 \<turnstile> a_insert_node ptr node reference_child \<rightarrow>\<^sub>h h'"
     using assms(5)
     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_child_nodes_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
         bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         split: if_splits option.splits)
 
   have "h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h2 adopt_node_removes_first_child assms(1) assms(2) assms(3) assms(6)
     by simp
   then have "h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h3
     by(auto simp add: set_disconnected_nodes_get_child_nodes
         dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes])
   then show ?thesis
     using h' assms(4)
     apply(auto simp add: a_insert_node_def
         elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1]
     by(auto simp add: set_child_nodes_get_child_nodes_different_pointers
         elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes])
 qed
 end
 
 locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_insert_before_defs + l_get_child_nodes_defs +
   assumes insert_before_removes_child:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> ptr \<noteq> ptr'
                         \<Longrightarrow> h \<turnstile> insert_before ptr node child \<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"
 
 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 get_ancestors_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 heap_is_wellformed type_wf known_ptr known_ptrs insert_before 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
 
 locale l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_child_nodes_get_disconnected_nodes +
   l_remove_child +
   l_get_root_node_wf +
   l_set_disconnected_nodes_get_disconnected_nodes_wf +
   l_set_disconnected_nodes_get_ancestors +
   l_get_ancestors_wf +
   l_get_owner_document +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf
 begin
 
 lemma insert_before_preserves_acyclitity:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> insert_before ptr node child \<rightarrow>\<^sub>h h'"
   shows "acyclic (parent_child_rel h')"
 proof -
   obtain ancestors reference_child owner_document h2 h3
     disconnected_nodes_h2
     where
       ancestors: "h \<turnstile> get_ancestors 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)
 
   have "known_ptr ptr"
     by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I assms
         l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)
 
   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 assms adopt_node_types_preserved
     by(auto simp add: a_remove_child_locs_def 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 have "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_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 "known_ptrs h2"
     using assms object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF assms(1) h2] assms by simp
 
   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 "known_ptrs h3"
     using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \<open>known_ptrs h2\<close> by blast
 
   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 "known_ptrs h'"
     using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \<open>known_ptrs h3\<close> 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 assms h2 adopt_node_removes_child 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 ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_ok object_ptr_kinds_M_eq2_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close>
     by (metis is_OK_returns_result_E object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2)
   have ancestors_h3: "h3 \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_separate_forwards)
     using \<open>heap_is_wellformed h2\<close> ancestors_h2
     by (auto simp add: set_disconnected_nodes_get_ancestors)
   have node_not_in_ancestors_h2: "cast node \<notin> set ancestors_h2"
     apply(rule get_ancestors_remains_not_in_ancestors[OF assms(1) wellformed_h2 ancestors ancestors_h2])
     using adopt_node_children_subset using h2 \<open>known_ptrs h\<close> \<open> type_wf h\<close> apply(blast)
     using node_not_in_ancestors apply(blast)
     using object_ptr_kinds_M_eq3_h apply(blast)
     using \<open>known_ptrs h\<close> apply(blast)
     using \<open>type_wf h\<close> apply(blast)
     using \<open>type_wf h2\<close> by blast
 
   have "acyclic (parent_child_rel h2)"
     using wellformed_h2  by (simp add: heap_is_wellformed_def acyclic_heap_def)
   then have "acyclic (parent_child_rel h3)"
     by(auto simp add: 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 adopt_node_removes_child
     using ancestors node_not_in_ancestors
     using \<open>known_ptrs h2\<close> \<open>type_wf h2\<close> ancestors_h2 local.get_ancestors_parent_child_rel
       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: parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
   moreover 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: 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)
   ultimately show "acyclic (parent_child_rel h')"
     by (auto simp add: heap_is_wellformed_def)
 qed
 
 lemma insert_before_heap_is_wellformed_preserved:
   assumes wellformed: "heap_is_wellformed h"
     and insert_before: "h \<turnstile> insert_before ptr node child \<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'"
 proof -
   obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors 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(2)
     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 "known_ptr ptr"
     by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs
         l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)
 
   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 type_wf adopt_node_types_preserved
     by(auto simp add: a_remove_child_locs_def 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_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 "known_ptrs h2"
     using known_ptrs object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF wellformed h2] known_ptrs type_wf .
 
   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 "known_ptrs h3"
     using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \<open>known_ptrs h2\<close> by blast
 
   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
 
   show "known_ptrs h'"
     using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \<open>known_ptrs h3\<close> 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 wellformed 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 ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_ok object_ptr_kinds_M_eq2_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close>
     by (metis is_OK_returns_result_E object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2)
   have ancestors_h3: "h3 \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_separate_forwards)
     using \<open>heap_is_wellformed h2\<close> ancestors_h2
     by (auto simp add: set_disconnected_nodes_get_ancestors)
   have node_not_in_ancestors_h2: "cast node \<notin> set ancestors_h2"
     apply(rule get_ancestors_remains_not_in_ancestors[OF assms(1) wellformed_h2 ancestors ancestors_h2])
     using adopt_node_children_subset using h2 \<open>known_ptrs h\<close> \<open> type_wf h\<close> apply(blast)
     using node_not_in_ancestors apply(blast)
     using object_ptr_kinds_M_eq3_h apply(blast)
     using \<open>known_ptrs h\<close> apply(blast)
     using \<open>type_wf h\<close> apply(blast)
     using \<open>type_wf h2\<close> by blast
 
   moreover have "a_acyclic_heap h'"
   proof -
     have "acyclic (parent_child_rel h2)"
       using wellformed_h2  by (simp add: heap_is_wellformed_def acyclic_heap_def)
     then have "acyclic (parent_child_rel h3)"
       by(auto simp add: 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_parent_child_rel node_not_in_ancestors_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close>
       using ancestors_h2 wellformed_h2 by blast
     then have "cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h3)\<^sup>*}"
       by(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
     moreover 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: 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)
     ultimately show ?thesis
       by(auto simp add: acyclic_heap_def)
   qed
 
 
   moreover have "a_all_ptrs_in_heap h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   have "a_all_ptrs_in_heap h'"
   proof -
     have "a_all_ptrs_in_heap h3"
       using \<open>a_all_ptrs_in_heap h2\<close>
       apply(auto simp add: 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 \<open>known_ptrs h2\<close> \<open>type_wf h3\<close> children_eq_h2 local.get_child_nodes_ok
           local.heap_is_wellformed_children_in_heap local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h2
           returns_result_select_result wellformed_h2)
       by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_h2
           disconnected_nodes_h3 document_ptr_kinds_commutes finite_set_in node_ptr_kinds_commutes
           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>a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq2_h3)[1]
       by (metis children_eq_h2 l_heap_is_wellformed.heap_is_wellformed_children_in_heap
           local.l_heap_is_wellformed_axioms node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h'
           object_ptr_kinds_M_eq3_h2 wellformed_h2)
 
     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 finite_set_in insert_before_list_in_set
           node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h'
           object_ptr_kinds_M_eq3_h2)
     then show ?thesis
       using \<open>a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def
           node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1]
       using children_eq_h3 children_h'
        apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD)
       by (metis (no_types) \<open>type_wf h'\<close> disconnected_nodes_eq2_h3 disconnected_nodes_eq_h3
           finite_set_in is_OK_returns_result_I local.get_disconnected_nodes_ok
           local.get_disconnected_nodes_ptr_in_heap returns_result_select_result subsetD)
   qed
 
   moreover have "a_distinct_lists h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h3"
   proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2
       children_eq2_h2 intro!: distinct_concat_map_I)[1]
     fix x
     assume 1: "x |\<in>| document_ptr_kinds h3"
       and 2: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                         (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
     show "distinct |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3]
         disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1
       by (metis (full_types) distinct_remove1 finite_fset fmember.rep_eq set_sorted_list_of_set)
   next
     fix x y xa
     assume 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                           (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and 2: "x |\<in>| document_ptr_kinds h3"
       and 3: "y |\<in>| document_ptr_kinds h3"
       and 4: "x \<noteq> y"
       and 5: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and 6: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r"
     show False
     proof (cases "x = owner_document")
       case True
       then have "y \<noteq> owner_document"
         using 4 by simp
       show ?thesis
         using distinct_concat_map_E(1)[OF 1]
         using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3]  select_result_I2[OF disconnected_nodes_h2]
         apply(auto simp add: True disconnected_nodes_eq2_h2[OF \<open>y \<noteq> owner_document\<close>])[1]
         by (metis (no_types, 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 fmember.rep_eq notin_set_remove1 select_result_I2
             set_sorted_list_of_set
           by (metis (no_types, lifting))
       qed
     qed
   next
     fix x xa xb
     assume 1: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h3 \<turnstile> get_child_nodes x|\<^sub>r)
                      \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 2: "xa |\<in>| object_ptr_kinds h3"
       and 3: "x \<in> set |h3 \<turnstile> get_child_nodes xa|\<^sub>r"
       and 4: "xb |\<in>| document_ptr_kinds h3"
       and 5: "x \<in> set |h3 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     have 6: "set |h3 \<turnstile> get_child_nodes xa|\<^sub>r \<inter> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
       using 1 2 4
       by (metis \<open>type_wf h2\<close> children_eq2_h2 document_ptr_kinds_commutes known_ptrs
           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 "a_distinct_lists h'"
   proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3
       disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)[1]
     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 known_ptrs 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.a_distinct_lists h3\<close> local.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>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disconnected_nodes_eq_h3
             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 "a_owner_document_valid h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: 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 children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2
         disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set object_ptr_kinds_M_eq3_h'
         ptr_in_heap select_result_I2)
 
   ultimately show "heap_is_wellformed h'"
     by (simp add: heap_is_wellformed_def)
 qed
 
 lemma adopt_node_children_remain_distinct:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'"
   shows "\<And>ptr' children'.
   h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> distinct children'"
   using assms(1) assms(2) assms(3) assms(4) local.adopt_node_preserves_wellformedness
     local.heap_is_wellformed_children_distinct
   by blast
 
 
 lemma insert_node_children_remain_distinct:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> a_insert_node ptr new_child reference_child_opt \<rightarrow>\<^sub>h h'"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "new_child \<notin> set children"
   shows "\<And>children'.
   h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children' \<Longrightarrow> distinct children'"
 proof -
   fix children'
   assume a1: "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'"
   have "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r (insert_before_list new_child reference_child_opt children)"
     using assms(4) assms(5) apply(auto simp add: a_insert_node_def elim!: bind_returns_heap_E)[1]
     using returns_result_eq set_child_nodes_get_child_nodes assms(2) assms(3)
     by (metis is_OK_returns_result_I local.get_child_nodes_ptr_in_heap local.get_child_nodes_pure
         local.known_ptrs_known_ptr pure_returns_heap_eq)
   moreover have "a_distinct_lists h"
     using assms local.heap_is_wellformed_def by blast
   then have "\<And>children. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
     \<Longrightarrow> distinct children"
     using assms local.heap_is_wellformed_children_distinct by blast
   ultimately show "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children' \<Longrightarrow> distinct children'"
     using assms(5) assms(6) insert_before_list_distinct returns_result_eq by fastforce
 qed
 
 lemma insert_before_children_remain_distinct:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> insert_before ptr new_child child_opt \<rightarrow>\<^sub>h h'"
   shows "\<And>ptr' children'.
   h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> distinct children'"
 proof -
   obtain reference_child owner_document h2 h3 disconnected_nodes_h2 where
     reference_child:
     "h \<turnstile> (if Some new_child = child_opt then a_next_sibling new_child else return child_opt) \<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 new_child \<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 new_child disconnected_nodes_h2) \<rightarrow>\<^sub>h h3" and
     h': "h3 \<turnstile> a_insert_node ptr new_child 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)
 
   have "\<And>ptr children. h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
       \<Longrightarrow> distinct children"
     using adopt_node_children_remain_distinct
     using assms(1) assms(2) assms(3) h2
     by blast
   moreover have "\<And>ptr children. h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
       \<Longrightarrow> new_child \<notin> set children"
     using adopt_node_removes_child
     using assms(1) assms(2) assms(3) h2
     by blast
   moreover have "\<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)
   ultimately show "\<And>ptr children. h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
       \<Longrightarrow> distinct children"
     using insert_node_children_remain_distinct
     by (meson assms(1) assms(2) assms(3) assms(4) insert_before_heap_is_wellformed_preserved(1)
         local.heap_is_wellformed_children_distinct)
 qed
 
 
 lemma insert_before_removes_child:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> insert_before ptr node child \<rightarrow>\<^sub>h h'"
   assumes "ptr \<noteq> ptr'"
   shows "\<And>children'. h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> node \<notin> set children'"
 proof -
   fix children'
   assume a1: "h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children'"
   obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors 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)
 
   have "known_ptr ptr"
     by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I assms(2)
         l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)
 
   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 assms(3) adopt_node_types_preserved
     by(auto simp add: a_remove_child_locs_def 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 have "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_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 "known_ptrs h2"
     using assms object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF assms(1) h2] assms by simp
 
   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 "known_ptrs h3"
     using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \<open>known_ptrs h2\<close> by blast
 
   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 "known_ptrs h'"
     using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \<open>known_ptrs h3\<close> 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 assms(1) assms(2) assms(3) h2 local.adopt_node_removes_child by blast
   show "node \<notin> set children'"
     using a1 assms(5) child_not_in_any_children children_eq_h2 children_eq_h3 by blast
 qed
 
 lemma ensure_pre_insertion_validity_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "ptr |\<in>| object_ptr_kinds h"
   assumes "\<not>is_character_data_ptr_kind parent"
   assumes "cast node \<notin> set |h \<turnstile> get_ancestors parent|\<^sub>r"
   assumes "h \<turnstile> get_parent ref \<rightarrow>\<^sub>r Some parent"
   assumes "is_document_ptr parent \<Longrightarrow> h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r []"
   assumes "is_document_ptr parent \<Longrightarrow> \<not>is_character_data_ptr_kind node"
   shows "h \<turnstile> ok (a_ensure_pre_insertion_validity node parent (Some ref))"
 proof -
   have "h \<turnstile> (if is_character_data_ptr_kind parent
         then error HierarchyRequestError else return ()) \<rightarrow>\<^sub>r ()"
     using assms
     by (simp add: assms(4))
   moreover have "h \<turnstile> do {
       ancestors \<leftarrow> get_ancestors parent;
       (if cast node \<in> set ancestors then error HierarchyRequestError else return ())
   } \<rightarrow>\<^sub>r ()"
     using assms(6)
     apply(auto intro!: bind_pure_returns_result_I)[1]
     using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap
     by auto
 
   moreover have "h \<turnstile> do {
       (case Some ref of
         Some child \<Rightarrow> do {
           child_parent \<leftarrow> get_parent child;
           (if child_parent \<noteq> Some parent then error NotFoundError else return ())}
       | None \<Rightarrow> return ())
   } \<rightarrow>\<^sub>r ()"
     using assms(7)
     by(auto split: option.splits)
   moreover have "h \<turnstile> do {
       children \<leftarrow> get_child_nodes parent;
       (if children \<noteq> [] \<and> is_document_ptr parent
         then error HierarchyRequestError else return ())
   } \<rightarrow>\<^sub>r ()"
     using assms(8)
     by (smt assms(5) assms(7) bind_pure_returns_result_I2 calculation(1) is_OK_returns_result_I
         local.get_child_nodes_pure local.get_parent_child_dual returns_result_eq)
 
   moreover have "h \<turnstile> do {
       (if is_character_data_ptr node \<and> is_document_ptr parent
         then error HierarchyRequestError else return ())
   } \<rightarrow>\<^sub>r ()"
     using assms
     using is_character_data_ptr_kind_none by force
   ultimately show ?thesis
     unfolding a_ensure_pre_insertion_validity_def
     apply(intro bind_is_OK_pure_I)
                 apply auto[1]
                apply auto[1]
               apply auto[1]
     using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap
              apply blast
             apply auto[1]
            apply auto[1]
     using assms(6)
            apply auto[1]
     using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap
           apply auto[1]
           apply (smt bind_returns_heap_E is_OK_returns_heap_E local.get_parent_pure pure_def
         pure_returns_heap_eq return_returns_heap returns_result_eq)
          apply(blast)
     using local.get_child_nodes_pure
         apply blast
        apply (meson assms(7) is_OK_returns_result_I local.get_parent_child_dual)
       apply (simp)
      apply (smt assms(5) assms(8) is_OK_returns_result_I returns_result_eq)
     by(auto)
 qed
 end
 
 locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs
   + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs +
   assumes insert_before_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes insert_before_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes insert_before_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
 
 interpretation i_insert_before_wf2?: l_insert_before_wf2\<^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 get_ancestors_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 remove_child
   remove_child_locs get_root_node get_root_node_locs
   by(simp add: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma insert_before_wf2_is_l_insert_before_wf2 [instances]:
   "l_insert_before_wf2 type_wf known_ptr known_ptrs insert_before heap_is_wellformed"
   apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1]
   using insert_before_heap_is_wellformed_preserved apply(fast, fast, fast)
   done
 
 
 
 locale l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before_wf2\<^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_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_child_wf2
 begin
 
 lemma next_sibling_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "node_ptr |\<in>| node_ptr_kinds h"
   shows "h \<turnstile> ok (a_next_sibling node_ptr)"
 proof -
   have "known_ptr (cast node_ptr)"
     using assms(2) assms(4) local.known_ptrs_known_ptr node_ptr_kinds_commutes by blast
   then show ?thesis
     using assms
     apply(auto simp add: a_next_sibling_def intro!: bind_is_OK_pure_I split: option.splits list.splits)[1]
     using get_child_nodes_ok local.get_parent_parent_in_heap local.known_ptrs_known_ptr by blast
 qed
 
 lemma remove_child_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   shows "h \<turnstile> ok (remove_child ptr child)"
 proof -
 
   have "ptr |\<in>| object_ptr_kinds h"
     using assms(4) local.get_child_nodes_ptr_in_heap by blast
   have "child |\<in>| node_ptr_kinds h"
     using assms(1) assms(4) assms(5) local.heap_is_wellformed_children_in_heap by blast
   have "\<not>is_character_data_ptr ptr"
   proof (rule ccontr, simp)
     assume "is_character_data_ptr ptr"
     then have "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
       using \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(simp add: get_child_nodes_def a_get_child_nodes_tups_def)
       apply(split invoke_splits)+
       by(auto simp add: get_child_nodes\<^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_def intro!: bind_pure_returns_result_I split: option.splits)
     then
     show False
       using assms returns_result_eq by fastforce
   qed
   have "is_character_data_ptr child \<Longrightarrow> \<not>is_document_ptr_kind ptr"
   proof (rule ccontr, simp)
     assume "is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child"
       and "is_document_ptr_kind ptr"
     then show False
       using assms
       using \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(simp add: get_child_nodes_def a_get_child_nodes_tups_def)
       apply(split invoke_splits)+
          apply(auto split: option.splits)[1]
           apply (meson invoke_empty is_OK_returns_result_I)
          apply (meson invoke_empty is_OK_returns_result_I)
       by(auto simp add: get_child_nodes\<^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: option.splits)
   qed
 
   obtain owner_document 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"
     by (meson \<open>child |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.get_owner_document_ok node_ptr_kinds_commutes)
   obtain disconnected_nodes_h where
     disconnected_nodes_h: "h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disconnected_nodes_h"
     by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_disconnected_nodes_ok
         local.get_owner_document_owner_document_in_heap owner_document)
   obtain h2 where
     h2: "h \<turnstile> set_disconnected_nodes owner_document (child # disconnected_nodes_h) \<rightarrow>\<^sub>h h2"
     by (meson assms(1) assms(2) assms(3) is_OK_returns_heap_E
         l_set_disconnected_nodes.set_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap
         local.l_set_disconnected_nodes_axioms owner_document)
 
   have "known_ptr ptr"
     using assms(2) assms(4) local.known_ptrs_known_ptr
     using \<open>ptr |\<in>| object_ptr_kinds h\<close> 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 assms(3)
     by(auto simp add: reflp_def transp_def)
 
   have "object_ptr_kinds h = object_ptr_kinds h2"
     using h2
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF set_disconnected_nodes_writes])
     using set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
 
   have "h2 \<turnstile> ok (set_child_nodes ptr (remove1 child children))"
   proof (cases "is_element_ptr_kind ptr")
     case True
     then show ?thesis
       using set_child_nodes_element_ok \<open>known_ptr ptr\<close> \<open>object_ptr_kinds h = object_ptr_kinds h2\<close>
         \<open>type_wf h2\<close> assms(4)
       using \<open>ptr |\<in>| object_ptr_kinds h\<close> by blast
   next
     case False
     then have "is_document_ptr_kind ptr"
       using \<open>known_ptr ptr\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> \<open>\<not>is_character_data_ptr ptr\<close>
       by(auto simp add:known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
     moreover have "is_document_ptr ptr"
       using \<open>known_ptr ptr\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close> False  \<open>\<not>is_character_data_ptr ptr\<close>
       by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
     ultimately show ?thesis
       using assms(4)
       apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def)[1]
       apply(split invoke_splits)+
          apply(auto elim!: bind_returns_result_E2 split: option.splits)[1]
         apply(auto simp add: get_child_nodes\<^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: option.splits)[1]
       using assms(5) apply auto[1]
       using \<open>is_document_ptr_kind ptr\<close> \<open>known_ptr ptr\<close> \<open>object_ptr_kinds h = object_ptr_kinds h2\<close>
         \<open>ptr |\<in>| object_ptr_kinds h\<close> \<open>type_wf h2\<close> local.set_child_nodes_document1_ok apply blast
       using \<open>is_document_ptr_kind ptr\<close> \<open>known_ptr ptr\<close> \<open>object_ptr_kinds h = object_ptr_kinds h2\<close>
         \<open>ptr |\<in>| object_ptr_kinds h\<close> \<open>type_wf h2\<close> is_element_ptr_kind_cast local.set_child_nodes_document2_ok
         apply blast
       using \<open>\<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\<close> apply blast
       by (metis False is_element_ptr_implies_kind option.case_eq_if)
   qed
   then
   obtain h' where
     h': "h2 \<turnstile> set_child_nodes ptr (remove1 child children) \<rightarrow>\<^sub>h h'"
     by auto
 
   show ?thesis
     using assms
     apply(auto simp add: remove_child_def
         simp add: is_OK_returns_heap_I[OF h2] is_OK_returns_heap_I[OF h']
         is_OK_returns_result_I[OF assms(4)] is_OK_returns_result_I[OF owner_document]
         is_OK_returns_result_I[OF disconnected_nodes_h]
         intro!: bind_is_OK_pure_I[OF get_owner_document_pure]
         bind_is_OK_pure_I[OF get_child_nodes_pure]
         bind_is_OK_pure_I[OF get_disconnected_nodes_pure]
         bind_is_OK_I[rotated, OF h2]
         dest!: returns_result_eq[OF assms(4)] returns_result_eq[OF owner_document]
         returns_result_eq[OF disconnected_nodes_h]
         )[1]
     using h2 returns_result_select_result by force
 qed
 
 lemma adopt_node_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "document_ptr |\<in>| document_ptr_kinds h"
   assumes "child |\<in>| node_ptr_kinds h"
   shows "h \<turnstile> ok (adopt_node document_ptr child)"
 proof -
   obtain old_document where
     old_document: "h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r old_document"
     by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E local.get_owner_document_ok
         node_ptr_kinds_commutes)
   then have "h \<turnstile> ok (get_owner_document (cast child))"
     by auto
   obtain parent_opt where
     parent_opt: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r parent_opt"
     by (meson assms(2) assms(3) is_OK_returns_result_I l_get_owner_document.get_owner_document_ptr_in_heap
         local.get_parent_ok local.l_get_owner_document_axioms node_ptr_kinds_commutes old_document
         returns_result_select_result)
   then have "h \<turnstile> ok (get_parent child)"
     by auto
 
   have "h \<turnstile> ok (case parent_opt of Some parent \<Rightarrow> remove_child parent child | None \<Rightarrow> return ())"
     apply(auto split: option.splits)[1]
     using remove_child_ok
     by (metis assms(1) assms(2) assms(3) local.get_parent_child_dual parent_opt)
   then
   obtain h2 where
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> remove_child parent child | None \<Rightarrow> return ()) \<rightarrow>\<^sub>h h2"
     by auto
 
   have "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 "old_document |\<in>| document_ptr_kinds h2"
     using assms(1) assms(2) assms(3) document_ptr_kinds_commutes
       local.get_owner_document_owner_document_in_heap old_document
     by blast
 
 
   have wellformed_h2: "heap_is_wellformed h2"
     using h2 remove_child_heap_is_wellformed_preserved assms
     by(auto split: option.splits)
   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)
 
 
   have "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 "document_ptr_kinds h = document_ptr_kinds h2"
     by(auto simp add: document_ptr_kinds_def)
 
   have "h2 \<turnstile> ok (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 ()
       })"
   proof(cases "document_ptr = old_document")
     case True
     then show ?thesis
       by simp
   next
     case False
     then have "h2 \<turnstile> ok (get_disconnected_nodes old_document)"
       by (simp add: \<open>old_document |\<in>| document_ptr_kinds h2\<close> \<open>type_wf h2\<close> local.get_disconnected_nodes_ok)
     then obtain old_disc_nodes where
       old_disc_nodes: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r old_disc_nodes"
       by auto
 
     have "h2 \<turnstile> ok (set_disconnected_nodes old_document (remove1 child old_disc_nodes))"
       by (simp add: \<open>old_document |\<in>| document_ptr_kinds h2\<close> \<open>type_wf h2\<close> local.set_disconnected_nodes_ok)
     then obtain h3 where
       h3: "h2 \<turnstile> set_disconnected_nodes old_document (remove1 child old_disc_nodes) \<rightarrow>\<^sub>h h3"
       by auto
 
 
     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 "type_wf h3"
       using \<open>type_wf h2\<close>
       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)
     moreover have "document_ptr |\<in>| document_ptr_kinds h3"
       using \<open>document_ptr_kinds h = document_ptr_kinds h2\<close> assms(4) document_ptr_kinds_eq3_h2 by auto
     ultimately have "h3 \<turnstile> ok (get_disconnected_nodes document_ptr)"
       by (simp add: local.get_disconnected_nodes_ok)
 
     then obtain disc_nodes where
       disc_nodes: "h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
       by auto
 
 
     have "h3 \<turnstile> ok (set_disconnected_nodes document_ptr (child # disc_nodes))"
       using \<open>document_ptr |\<in>| document_ptr_kinds h3\<close> \<open>type_wf h3\<close> local.set_disconnected_nodes_ok by auto
     then obtain h' where
       h': "h3 \<turnstile> set_disconnected_nodes document_ptr (child # disc_nodes) \<rightarrow>\<^sub>h h'"
       by auto
 
     then show ?thesis
       using False
       using \<open>h2 \<turnstile> ok get_disconnected_nodes old_document\<close>
       using \<open>h3 \<turnstile> ok get_disconnected_nodes document_ptr\<close>
       apply(auto dest!: returns_result_eq[OF old_disc_nodes] returns_result_eq[OF disc_nodes]
           intro!: bind_is_OK_I[rotated, OF h3] bind_is_OK_pure_I[OF get_disconnected_nodes_pure] )[1]
       using \<open>h2 \<turnstile> ok set_disconnected_nodes old_document (remove1 child old_disc_nodes)\<close> by auto
   qed
   then obtain h' where
     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'"
     by auto
 
   show ?thesis
     using \<open>h \<turnstile> ok (get_owner_document (cast child))\<close>
     using \<open>h \<turnstile> ok (get_parent child)\<close>
     using h2 h'
     apply(auto simp add: adopt_node_def
         simp add: is_OK_returns_heap_I[OF h2]
         intro!: bind_is_OK_pure_I[OF get_owner_document_pure]
         bind_is_OK_pure_I[OF get_parent_pure]
         bind_is_OK_I[rotated, OF h2]
         dest!: returns_result_eq[OF parent_opt] returns_result_eq[OF old_document])[1]
     using \<open>h \<turnstile> ok (case parent_opt of None \<Rightarrow> return () | Some parent \<Rightarrow> remove_child parent child)\<close>
     by auto
 qed
 
 lemma insert_node_ok:
   assumes "known_ptr parent" and "type_wf h"
   assumes "parent |\<in>| object_ptr_kinds h"
   assumes "\<not>is_character_data_ptr_kind parent"
   assumes "is_document_ptr parent \<Longrightarrow> h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r []"
   assumes "is_document_ptr parent \<Longrightarrow> \<not>is_character_data_ptr_kind node"
   assumes "known_ptr (cast node)"
   shows "h \<turnstile> ok (a_insert_node parent node ref)"
 proof(auto simp add: a_insert_node_def get_child_nodes_ok[OF assms(1) assms(2) assms(3)]
     intro!: bind_is_OK_pure_I)
   fix children'
   assume "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children'"
 
   show "h \<turnstile> ok set_child_nodes parent (insert_before_list node ref children')"
   proof (cases "is_element_ptr_kind parent")
     case True
     then show ?thesis
       using set_child_nodes_element_ok
       using assms(1) assms(2) assms(3) by blast
   next
     case False
     then have "is_document_ptr_kind parent"
       using assms(4) assms(1)
       by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
     then have "is_document_ptr parent"
       using assms(1)
       by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
     then obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children" and "children = []"
       using assms(5) by blast
 
     have "insert_before_list node ref children' = [node]"
       by (metis \<open>children = []\<close> \<open>h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children'\<close> append.left_neutral
           children insert_Nil l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.insert_before_list.elims
           l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.insert_before_list.simps(3) neq_Nil_conv returns_result_eq)
     moreover have "\<not>is_character_data_ptr_kind node"
       using \<open>is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r parent\<close> assms(6) by blast
     then have "is_element_ptr_kind node"
       by (metis (no_types, lifting) CharacterDataClass.a_known_ptr_def DocumentClass.a_known_ptr_def
           ElementClass.a_known_ptr_def NodeClass.a_known_ptr_def assms(7) 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_inject
           document_ptr_no_node_ptr_cast is_character_data_ptr_kind_none is_document_ptr_kind_none
           is_element_ptr_implies_kind is_node_ptr_kind_cast local.known_ptr_impl node_ptr_casts_commute3
           option.case_eq_if)
     ultimately
     show ?thesis
       using set_child_nodes_document2_ok
       by (metis \<open>is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r parent\<close> assms(1) assms(2) assms(3) assms(5)
           is_document_ptr_kind_none option.case_eq_if)
   qed
 qed
 
 lemma insert_before_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "parent |\<in>| object_ptr_kinds h"
   assumes "node |\<in>| node_ptr_kinds h"
   assumes "\<not>is_character_data_ptr_kind parent"
   assumes "cast node \<notin> set |h \<turnstile> get_ancestors parent|\<^sub>r"
   assumes "h \<turnstile> get_parent ref \<rightarrow>\<^sub>r Some parent"
   assumes "is_document_ptr parent \<Longrightarrow> h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r []"
   assumes "is_document_ptr parent \<Longrightarrow> \<not>is_character_data_ptr_kind node"
   shows "h \<turnstile> ok (insert_before parent node (Some ref))"
 proof -
   have "h \<turnstile> ok (a_ensure_pre_insertion_validity node parent (Some ref))"
     using assms ensure_pre_insertion_validity_ok by blast
   have "h \<turnstile> ok (if Some node = Some ref
         then a_next_sibling node
         else return (Some ref))" (is "h \<turnstile> ok ?P")
     apply(auto split: if_splits)[1]
     using assms(1) assms(2) assms(3) assms(5) next_sibling_ok by blast
 
   then obtain reference_child where
     reference_child: "h \<turnstile> ?P \<rightarrow>\<^sub>r reference_child"
     by auto
 
   obtain owner_document where
     owner_document: "h \<turnstile> get_owner_document parent \<rightarrow>\<^sub>r owner_document"
     using assms get_owner_document_ok
     by (meson returns_result_select_result)
   then have "h \<turnstile> ok (get_owner_document parent)"
     by auto
   have "owner_document |\<in>| document_ptr_kinds h"
     using assms(1) assms(2) assms(3) local.get_owner_document_owner_document_in_heap owner_document
     by blast
 
   obtain h2 where
     h2: "h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h2"
     by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_heap_E adopt_node_ok
         l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
         local.get_owner_document_owner_document_in_heap owner_document)
   then have "h \<turnstile> ok (adopt_node owner_document node)"
     by auto
   have "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 "document_ptr_kinds h = document_ptr_kinds h2"
     by(auto simp add: document_ptr_kinds_def)
   have "heap_is_wellformed h2"
     using h2 adopt_node_preserves_wellformedness assms by blast
   have "known_ptrs h2"
     using h2 adopt_node_preserves_known_ptrs assms by blast
   have "type_wf h2"
     using h2 adopt_node_preserves_type_wf assms by blast
 
   obtain disconnected_nodes_h2 where
     disconnected_nodes_h2: "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disconnected_nodes_h2"
     by (metis \<open>document_ptr_kinds h = document_ptr_kinds h2\<close> \<open>type_wf h2\<close> assms(1) assms(2) assms(3)
         is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap
         owner_document)
 
   obtain h3 where
     h3: "h2 \<turnstile> set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \<rightarrow>\<^sub>h h3"
     by (metis \<open>document_ptr_kinds h = document_ptr_kinds h2\<close> \<open>owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>type_wf h2\<close> document_ptr_kinds_def is_OK_returns_heap_E
         l_set_disconnected_nodes.set_disconnected_nodes_ok local.l_set_disconnected_nodes_axioms)
 
   have "type_wf h3"
     using \<open>type_wf h2\<close>
     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)
 
   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)
 
   have "parent |\<in>| object_ptr_kinds h3"
     using \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> assms(4) object_ptr_kinds_M_eq3_h2 by blast
   moreover have "known_ptr parent"
     using assms(2) assms(4) local.known_ptrs_known_ptr by blast
   moreover have "known_ptr (cast node)"
     using assms(2) assms(5) local.known_ptrs_known_ptr node_ptr_kinds_commutes by blast
   moreover have "is_document_ptr parent \<Longrightarrow> h3 \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r []"
     by (metis assms(8) assms(9) distinct.simps(2) distinct_singleton local.get_parent_child_dual
         returns_result_eq)
   ultimately obtain h' where
     h': "h3 \<turnstile> a_insert_node parent node reference_child \<rightarrow>\<^sub>h h'"
     using insert_node_ok \<open>type_wf h3\<close> assms by blast
 
   show ?thesis
     using \<open>h \<turnstile> ok (a_ensure_pre_insertion_validity node parent (Some ref))\<close>
     using reference_child \<open>h \<turnstile> ok (get_owner_document parent)\<close> \<open>h \<turnstile> ok (adopt_node owner_document node)\<close>
       h3 h'
     apply(auto simp add: insert_before_def
         simp add: is_OK_returns_result_I[OF disconnected_nodes_h2]
         simp add: is_OK_returns_heap_I[OF h3] is_OK_returns_heap_I[OF h']
         intro!: bind_is_OK_I2
         bind_is_OK_pure_I[OF ensure_pre_insertion_validity_pure]
         bind_is_OK_pure_I[OF next_sibling_pure]
         bind_is_OK_pure_I[OF get_owner_document_pure]
         bind_is_OK_pure_I[OF get_disconnected_nodes_pure]
         dest!: returns_result_eq[OF owner_document] returns_result_eq[OF disconnected_nodes_h2]
         returns_heap_eq[OF h2] returns_heap_eq[OF h3]
         dest!: sym[of node ref]
         )[1]
     using returns_result_eq by fastforce
 qed
 end
 
 interpretation i_insert_before_wf3?: l_insert_before_wf3\<^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 get_ancestors_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 remove_child remove_child_locs get_root_node get_root_node_locs remove
   by(auto simp add: l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 locale l_append_child_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_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_insert_before_wf +
   l_insert_before_wf2  +
   l_get_child_nodes
 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_preserves_type_wf
       insert_before_preserves_known_ptrs insert_before_heap_is_wellformed_preserved)
 
 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 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 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_heap_is_wellformed_preserved insert_before_preserves_known_ptrs
       insert_before_preserves_type_wf 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
 
 locale l_append_child_wf = l_type_wf + l_known_ptrs + l_append_child_defs + l_heap_is_wellformed_defs +
   assumes append_child_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes append_child_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes append_child_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
 
 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 get_ancestors_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)
 
 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+
 
 
 subsection \<open>create\_element\<close>
 
 locale l_create_element_wf\<^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 parent_child_rel +
   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>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 create_element known_ptr +
   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_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_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"
 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 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 local.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)
 
   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_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
       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 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 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_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 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 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 "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 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 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 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 "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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)[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 local.get_child_nodes_ok local.known_ptrs_known_ptr
         local.parent_child_rel_child_in_heap local.parent_child_rel_child_nodes2 node_ptr_kinds_commutes
         node_ptr_kinds_eq_h returns_result_select_result)
     by (metis assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funion_iff
         local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h
         returns_result_select_result)
   then have "a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "a_all_ptrs_in_heap h'"
     by (smt \<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_h3
         disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
         finite_set_in h' is_OK_returns_result_I set_disconnected_nodes_get_disconnected_nodes
         local.a_all_ptrs_in_heap_def local.get_child_nodes_ptr_in_heap node_ptr_kinds_commutes
         object_ptr_kinds_eq_h2 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 a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem 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 "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
 
     using \<open>h2 \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: 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 local.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>local.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
         local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result)
 
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)
   then have "a_distinct_lists h'"
   proof(auto simp add: 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>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disc_nodes_h3 distinct.simps(2)
           distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq
           returns_result_select_result)
   next
     fix x y xa
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                             (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
       and "y |\<in>| document_ptr_kinds h3"
       and "x \<noteq> y"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     moreover have "set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
       using calculation by(auto dest: distinct_concat_map_E(1))
     ultimately show "False"
       apply(-)
       apply(cases "x = document_ptr")
        apply (smt NodeMonad.ptr_kinds_ptr_kinds_M \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
           \<open>local.a_all_ptrs_in_heap h\<close>
           disc_nodes_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           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)
       by (smt NodeMonad.ptr_kinds_ptr_kinds_M \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
           \<open>local.a_all_ptrs_in_heap h\<close>
           disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply -
       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>a_distinct_lists h3\<close> children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h'
           select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes)
       by (metis "3" "4" "5" "6" \<open>a_distinct_lists h3\<close> \<open>type_wf h3\<close> children_eq2_h3
           distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(auto simp add: 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 (smt 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
         children_eq2_h2 children_eq2_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
         disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h' list.set_intros(2)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
 
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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
   using instances
   by(auto simp add: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsection \<open>create\_character\_data\<close>
 
 locale l_create_character_data_wf\<^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 parent_child_rel
   + 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_create_character_data\<^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_val set_val_locs type_wf create_character_data known_ptr
   + 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_new_character_data
   type_wf
   + l_known_ptrs
   known_ptr known_ptrs
   for known_ptr :: "(_::linorder) 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 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_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_character_data ::
     "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) character_data_ptr) prog"
     and known_ptrs :: "(_) 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: create_character_data_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF 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: 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.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 set_val_writes h3])
     using 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 "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       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 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 set_val_writes h3])
     using 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 "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       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 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 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 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_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 get_disconnected_nodes_reads 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 "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 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 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 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 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 acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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)[1]
     using node_ptr_kinds_eq_h \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
      apply (metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \<open>parent_child_rel h = parent_child_rel h2\<close>
         children_eq2_h finite_set_in finsert_iff funion_finsert_right local.parent_child_rel_child
         local.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 assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funionI1
         local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap
         node_ptr_kinds_eq_h returns_result_select_result)
   then have "a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "a_all_ptrs_in_heap h'"
     by (smt   character_data_ptr_kinds_commutes children_eq2_h3 disc_nodes_document_ptr_h2
         disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
         finite_set_in h' h2 local.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_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_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 a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem 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 "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: 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 local.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>local.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
         local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result)
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)[1]
   then have "a_distinct_lists h'"
   proof(auto simp add: 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 new_character_data_ptr \<notin> set disc_nodes_h3\<close>
           \<open>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disc_nodes_h3 distinct.simps(2)
           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 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>
           \<open>local.a_all_ptrs_in_heap h\<close> disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal
           document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                   \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply(cases "xb = document_ptr")
        apply (metis (no_types, opaque_lifting) "3" "4" "6"
           \<open>\<And>p. p |\<in>| object_ptr_kinds h3 \<Longrightarrow> cast new_character_data_ptr \<notin> set |h3 \<turnstile> get_child_nodes p|\<^sub>r\<close>
           \<open>a_distinct_lists h3\<close> children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h'
           select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes)
       by (metis "3" "4" "5" "6" \<open>a_distinct_lists h3\<close> \<open>type_wf h3\<close> children_eq2_h3
           distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(simp add: 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 (smt ObjectMonad.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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> children_eq2_h
         disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h' list.set_intros(2)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
 
   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
 
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_character_data_wf?: l_create_character_data_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 get_disconnected_nodes get_disconnected_nodes_locs
   heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_character_data known_ptrs
   using instances
   by (auto simp add: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsection \<open>create\_document\<close>
 
 locale l_create_document_wf\<^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 parent_child_rel
   + 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_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 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_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_val_locs :: "(_) character_data_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and create_document :: "((_) heap, exception, (_) document_ptr) prog"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
 begin
 
 lemma create_document_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> create_document \<rightarrow>\<^sub>h h'"
     and "type_wf h"
     and "known_ptrs h"
   shows "heap_is_wellformed h'"
 proof -
   obtain new_document_ptr where
     new_document_ptr: "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr" and
     h': "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
     using assms(2)
     apply(simp add: create_document_def)
     using new_document_ok by blast
 
   have "new_document_ptr \<notin> set |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
   have "new_document_ptr |\<notin>| document_ptr_kinds h"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr |\<notin>| object_ptr_kinds h"
     by simp
 
   have object_ptr_kinds_eq: "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_document_ptr|}"
     using new_document_new_ptr h' new_document_ptr by blast
   then have node_ptr_kinds_eq: "node_ptr_kinds h' = node_ptr_kinds h"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h' = character_data_ptr_kinds h"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h: "element_ptr_kinds h' = element_ptr_kinds h"
     using object_ptr_kinds_eq
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h' = document_ptr_kinds h |\<union>| {|new_document_ptr|}"
     using object_ptr_kinds_eq
     apply(auto simp add: document_ptr_kinds_def)[1]
     by (metis (no_types, lifting) document_ptr_kinds_commutes document_ptr_kinds_def finsertI1 fset.map_comp)
 
 
   have 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 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 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 (simp add: heap_is_wellformed_def acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h'"
   proof(auto simp add: 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 "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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 h'"
     apply(auto simp add: 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 local.parent_child_rel_child
       local.parent_child_rel_parent_in_heap node_ptr_kinds_eq
      apply (metis (no_types, lifting) \<open>h' \<turnstile> get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \<rightarrow>\<^sub>r []\<close>
         children_eq2 finite_set_in finsert_iff funion_finsert_right object_ptr_kinds_eq
         select_result_I2 subsetD sup_bot.right_neutral)
     by (metis (no_types, lifting) \<open>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>
         \<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>
         \<open>h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []\<close>
         \<open>parent_child_rel h = parent_child_rel h'\<close> \<open>type_wf h'\<close> assms(1) disconnected_nodes_eq_h
         local.get_disconnected_nodes_ok
         local.heap_is_wellformed_disc_nodes_in_heap local.parent_child_rel_child
         local.parent_child_rel_parent_in_heap
         node_ptr_kinds_eq returns_result_select_result select_result_I2)
   have "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "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] 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]
     using disconnected_nodes_eq_h
     apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.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>local.a_distinct_lists h\<close> assms(3) disconnected_nodes_eq2_h
           local.distinct_lists_no_parent local.get_disconnected_nodes_ok
           returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: a_owner_document_valid_def)[1]
     by (metis \<open>cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr |\<notin>| object_ptr_kinds h\<close>
         children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in
         funion_iff node_ptr_kinds_eq object_ptr_kinds_eq)
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_document_wf?: l_create_document_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 get_disconnected_nodes
   get_disconnected_nodes_locs heap_is_wellformed parent_child_rel
   set_val set_val_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_document known_ptrs
   using instances
   by (auto simp add: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 end
diff --git a/thys/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy b/thys/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy
--- a/thys/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy
+++ b/thys/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy
@@ -1,6965 +1,6965 @@
 (***********************************************************************************
  * Copyright (c) 2016-2018 The University of Sheffield, 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>Wellformedness\<close>
 text\<open>In this theory, we discuss the wellformedness of the DOM. First, we define
 wellformedness and, second, we show for all functions for querying and modifying the
 DOM to what extend they preserve wellformendess.\<close>
 
 theory Core_DOM_Heap_WF
   imports
     "Core_DOM_Functions"
 begin
 
 locale l_heap_is_wellformed\<^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_disconnected_nodes_defs get_disconnected_nodes get_disconnected_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"
 begin
 definition a_owner_document_valid :: "(_) heap \<Rightarrow> bool"
   where
     "a_owner_document_valid h \<longleftrightarrow> (\<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 h
             \<and> node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)))"
 
 lemma a_owner_document_valid_code [code]: "a_owner_document_valid h \<longleftrightarrow> node_ptr_kinds h |\<subseteq>|
   fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)) @
 map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))
 "
   apply(auto simp add: a_owner_document_valid_def l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_owner_document_valid_def)[1]
 proof -
   fix x
   assume 1: " \<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 h \<and> node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
   assume 2: "x |\<in>| node_ptr_kinds h"
   assume 3: "x |\<notin>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
   have "\<not>(\<exists>document_ptr. document_ptr |\<in>| document_ptr_kinds h \<and> x \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)"
     using 1 2 3
     by (smt UN_I fset_of_list_elem image_eqI notin_fset set_concat set_map sorted_list_of_fset_simps(1))
   then
   have "(\<exists>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<and> x \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
     using 1 2
     by auto
   then obtain parent_ptr where parent_ptr: "parent_ptr |\<in>| object_ptr_kinds h \<and>
 x \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
     by auto
   moreover have "parent_ptr \<in> set (sorted_list_of_fset (object_ptr_kinds h))"
     using parent_ptr by auto
   moreover have "|h \<turnstile> get_child_nodes parent_ptr|\<^sub>r \<in> set (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))"
     using calculation(2) by auto
   ultimately
   show "x |\<in>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h))))"
     using fset_of_list_elem by fastforce
 next
   fix node_ptr
   assume 1: "node_ptr_kinds h |\<subseteq>| fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))) |\<union>|
 fset_of_list (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
   assume 2: "node_ptr |\<in>| node_ptr_kinds h"
   assume 3: "\<forall>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<longrightarrow> node_ptr \<notin> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
   have "node_ptr \<in> set (concat (map (\<lambda>parent. |h \<turnstile> get_child_nodes parent|\<^sub>r)
 (sorted_list_of_fset (object_ptr_kinds h)))) \<or>
 node_ptr \<in> set (concat (map (\<lambda>parent. |h \<turnstile> get_disconnected_nodes parent|\<^sub>r)
 (sorted_list_of_fset (document_ptr_kinds h))))"
     using 1 2
     by (meson fin_mono fset_of_list_elem funion_iff)
   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 3
     by auto
 qed
 
 definition a_parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   where
     "a_parent_child_rel h = {(parent, child). parent |\<in>| object_ptr_kinds h
                             \<and> child \<in> cast ` set |h \<turnstile> get_child_nodes parent|\<^sub>r}"
 
 lemma a_parent_child_rel_code [code]: "a_parent_child_rel h = set (concat (map
   (\<lambda>parent. map
     (\<lambda>child. (parent, 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))
     |h \<turnstile> get_child_nodes parent|\<^sub>r)
   (sorted_list_of_fset (object_ptr_kinds h)))
 )"
   by(auto simp add: a_parent_child_rel_def)
 
 definition a_acyclic_heap :: "(_) heap \<Rightarrow> bool"
   where
     "a_acyclic_heap h = acyclic (a_parent_child_rel h)"
 
 definition a_all_ptrs_in_heap :: "(_) heap \<Rightarrow> bool"
   where
     "a_all_ptrs_in_heap h \<longleftrightarrow>
       (\<forall>ptr \<in> fset (object_ptr_kinds h). set |h \<turnstile> get_child_nodes ptr|\<^sub>r \<subseteq> fset (node_ptr_kinds h)) \<and>
       (\<forall>document_ptr \<in> fset (document_ptr_kinds h).
 set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r \<subseteq> fset (node_ptr_kinds h))"
 
 definition a_distinct_lists :: "(_) heap \<Rightarrow> bool"
   where
     "a_distinct_lists h = distinct (concat (
       (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)
    @ (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r)
     ))"
 
 definition a_heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   where
     "a_heap_is_wellformed h \<longleftrightarrow>
       a_acyclic_heap h \<and> a_all_ptrs_in_heap h \<and> a_distinct_lists h \<and> a_owner_document_valid h"
 end
 
 locale l_heap_is_wellformed_defs =
   fixes heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   fixes parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
 
 global_interpretation 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
   defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes
                      get_disconnected_nodes"
     and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes"
     and acyclic_heap = a_acyclic_heap
     and all_ptrs_in_heap = a_all_ptrs_in_heap
     and distinct_lists = a_distinct_lists
     and owner_document_valid = a_owner_document_valid
   .
 
 locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs
   + 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_heap_is_wellformed_defs heap_is_wellformed parent_child_rel
   + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_::linorder) 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 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" +
   assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed"
   assumes parent_child_rel_impl: "parent_child_rel = a_parent_child_rel"
 begin
 lemmas heap_is_wellformed_def = heap_is_wellformed_impl[unfolded a_heap_is_wellformed_def]
 lemmas parent_child_rel_def = parent_child_rel_impl[unfolded a_parent_child_rel_def]
 lemmas acyclic_heap_def = a_acyclic_heap_def[folded parent_child_rel_impl]
 
 lemma parent_child_rel_node_ptr:
   "(parent, child) \<in> parent_child_rel h \<Longrightarrow> is_node_ptr_kind child"
   by(auto simp add: parent_child_rel_def)
 
 lemma parent_child_rel_child_nodes:
   assumes "known_ptr parent"
     and "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     and "child \<in> set children"
   shows "(parent, cast child) \<in> parent_child_rel h"
   using assms
   apply(auto simp add: parent_child_rel_def is_OK_returns_result_I )[1]
   using get_child_nodes_ptr_in_heap by blast
 
 lemma parent_child_rel_child_nodes2:
   assumes "known_ptr parent"
     and "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     and "child \<in> set children"
     and "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 = child_obj"
   shows "(parent, child_obj) \<in> parent_child_rel h"
   using assms parent_child_rel_child_nodes by blast
 
 
 lemma parent_child_rel_finite: "finite (parent_child_rel h)"
 proof -
   have "parent_child_rel h = (\<Union>ptr \<in> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r.
                  (\<Union>child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r. {(ptr, cast child)}))"
     by(auto simp add: parent_child_rel_def)
   moreover have "finite (\<Union>ptr \<in> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r.
                     (\<Union>child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r. {(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 child)}))"
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 lemma distinct_lists_no_parent:
   assumes "a_distinct_lists h"
   assumes "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assumes "node_ptr \<in> set disc_nodes"
   shows "\<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 assms
   apply(auto simp add: a_distinct_lists_def)[1]
 proof -
   fix parent_ptr :: "(_) object_ptr"
   assume a1: "parent_ptr |\<in>| object_ptr_kinds h"
   assume a2: "(\<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) = {}"
   assume a3: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assume a4: "node_ptr \<in> set disc_nodes"
   assume a5: "node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
   have f6: "parent_ptr \<in> fset (object_ptr_kinds h)"
     using a1 by auto
   have f7: "document_ptr \<in> fset (document_ptr_kinds h)"
     using a3 by (meson fmember.rep_eq get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I)
   have "|h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = disc_nodes"
     using a3 by simp
   then show False
     using f7 f6 a5 a4 a2 by blast
 qed
 
 
 lemma distinct_lists_disconnected_nodes:
   assumes "a_distinct_lists h"
     and "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   shows "distinct disc_nodes"
 proof -
   have h1: "distinct (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                              |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
     using assms(1)
     by(simp add: a_distinct_lists_def)
   then show ?thesis
     using concat_map_all_distinct[OF h1] assms(2) is_OK_returns_result_I get_disconnected_nodes_ok
     by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M
         l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap
         l_get_disconnected_nodes_axioms select_result_I2)
 qed
 
 lemma distinct_lists_children:
   assumes "a_distinct_lists h"
     and "known_ptr ptr"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   shows "distinct children"
 proof (cases "children = []", simp)
   assume "children \<noteq> []"
   have h1: "distinct (concat ((map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)))"
     using assms(1)
     by(simp add: a_distinct_lists_def)
   show ?thesis
     using concat_map_all_distinct[OF h1] assms(2) assms(3)
     by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap
         is_OK_returns_result_I select_result_I2)
 qed
 
 lemma heap_is_wellformed_children_in_heap:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   shows "child |\<in>| node_ptr_kinds h"
   using assms
   apply(auto simp add: heap_is_wellformed_def a_all_ptrs_in_heap_def)[1]
   by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I
       local.get_child_nodes_ptr_in_heap select_result_I2 subsetD)
 
 lemma heap_is_wellformed_one_parent:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children'"
   assumes "set children \<inter> set children' \<noteq> {}"
   shows "ptr = ptr'"
   using assms
 proof (auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1]
   fix x :: "(_) node_ptr"
   assume a1: "ptr \<noteq> ptr'"
   assume a2: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assume a3: "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children'"
   assume a4: "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r)
                                      (sorted_list_of_set (fset (object_ptr_kinds h)))))"
   have f5: "|h \<turnstile> get_child_nodes ptr|\<^sub>r = children"
     using a2 by simp
   have "|h \<turnstile> get_child_nodes ptr'|\<^sub>r = children'"
     using a3 by (meson select_result_I2)
   then have "ptr \<notin> set (sorted_list_of_set (fset (object_ptr_kinds h)))
           \<or> ptr' \<notin> set (sorted_list_of_set (fset (object_ptr_kinds h)))
           \<or> set children \<inter> set children' = {}"
     using f5 a4 a1 by (meson distinct_concat_map_E(1))
   then show False
     using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I
         local.get_child_nodes_ptr_in_heap set_sorted_list_of_set)
 qed
 
 lemma parent_child_rel_child:
   "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> child \<in> set children \<longleftrightarrow> (ptr, cast child) \<in> parent_child_rel h"
   by (simp add: is_OK_returns_result_I get_child_nodes_ptr_in_heap parent_child_rel_def)
 
 lemma parent_child_rel_acyclic: "heap_is_wellformed h \<Longrightarrow> acyclic (parent_child_rel h)"
   by (simp add: acyclic_heap_def local.heap_is_wellformed_def)
 
 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 distinct_lists_disconnected_nodes local.heap_is_wellformed_def by blast
 
 lemma parent_child_rel_parent_in_heap:
   "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> parent |\<in>| object_ptr_kinds h"
   using local.parent_child_rel_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"
   apply(auto simp add: heap_is_wellformed_def parent_child_rel_def a_all_ptrs_in_heap_def)[1]
   using get_child_nodes_ok
   by (meson finite_set_in subsetD)
 
 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"
   by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.a_all_ptrs_in_heap_def
       local.get_disconnected_nodes_ptr_in_heap local.heap_is_wellformed_def select_result_I2 subsetD)
 
 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 DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1)
     is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap
     local.heap_is_wellformed_def select_result_I2
 proof -
   assume a1: "heap_is_wellformed h"
   assume a2: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assume a3: "h \<turnstile> get_disconnected_nodes document_ptr' \<rightarrow>\<^sub>r disc_nodes'"
   assume a4: "set disc_nodes \<inter> set disc_nodes' \<noteq> {}"
   have f5: "|h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = disc_nodes"
     using a2 by (meson select_result_I2)
   have f6: "|h \<turnstile> get_disconnected_nodes document_ptr'|\<^sub>r = disc_nodes'"
     using a3 by (meson select_result_I2)
   have "\<And>nss nssa. \<not> distinct (concat (nss @ nssa)) \<or> distinct (concat nssa::(_) node_ptr list)"
     by (metis (no_types) concat_append distinct_append)
   then have "distinct (concat (map (\<lambda>d. |h \<turnstile> get_disconnected_nodes d|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
     using a1 local.a_distinct_lists_def local.heap_is_wellformed_def by blast
   then show ?thesis
     using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1)
         is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap)
 qed
 
 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 = {}"
   by (metis (no_types, opaque_lifting) disjoint_iff_not_equal distinct_lists_no_parent
       is_OK_returns_result_I local.get_child_nodes_ptr_in_heap
       local.heap_is_wellformed_def select_result_I2)
 
 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)"
   apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def a_owner_document_valid_def)[1]
   by (meson fmember.rep_eq)
 lemma heap_is_wellformed_children_distinct:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
   by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append
       distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def
       local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def
       select_result_I2)
 end
 
 locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_get_disconnected_nodes_defs +
   assumes 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"
   assumes 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"
   assumes 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'"
   assumes 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'"
   assumes 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 = {}"
   assumes 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"
   assumes heap_is_wellformed_children_distinct:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
   assumes 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)"
   assumes parent_child_rel_child:
     "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
    \<Longrightarrow> child \<in> set children \<longleftrightarrow> (ptr, cast child) \<in> parent_child_rel h"
   assumes parent_child_rel_finite:
     "heap_is_wellformed h \<Longrightarrow> finite (parent_child_rel h)"
   assumes parent_child_rel_acyclic:
     "heap_is_wellformed h \<Longrightarrow> acyclic (parent_child_rel h)"
   assumes parent_child_rel_node_ptr:
     "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> is_node_ptr_kind child_ptr"
   assumes parent_child_rel_parent_in_heap:
     "(parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> parent |\<in>| object_ptr_kinds h"
   assumes 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"
 
 interpretation i_heap_is_wellformed?: 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 parent_child_rel
   apply(unfold_locales)
   by(auto simp add: heap_is_wellformed_def parent_child_rel_def)
 declare 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_is_l_heap_is_wellformed [instances]:
   "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes
                         get_disconnected_nodes"
   apply(auto simp add: l_heap_is_wellformed_def)[1]
   using heap_is_wellformed_children_in_heap
                 apply blast
   using heap_is_wellformed_disc_nodes_in_heap
                apply blast
   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 blast
   using heap_is_wellformed_children_distinct
           apply blast
   using heap_is_wellformed_children_disc_nodes
          apply blast
   using parent_child_rel_child
         apply (blast)
   using parent_child_rel_child
        apply(blast)
   using parent_child_rel_finite
       apply blast
   using parent_child_rel_acyclic
      apply blast
   using parent_child_rel_node_ptr
     apply blast
   using parent_child_rel_parent_in_heap
    apply blast
   using parent_child_rel_child_in_heap
   apply blast
   done
 
 subsection \<open>get\_parent\<close>
 
 locale l_get_parent_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
   known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs
   + l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_::linorder) 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 get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_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 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
 lemma child_parent_dual:
   assumes heap_is_wellformed: "heap_is_wellformed h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   assumes "known_ptrs h"
   assumes type_wf: "type_wf h"
   shows "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
 proof -
   obtain ptrs where ptrs: "h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by(simp add: object_ptr_kinds_M_defs)
   then have h1: "ptr \<in> set ptrs"
     using get_child_nodes_ok assms(2) is_OK_returns_result_I
     by (metis (no_types, opaque_lifting) ObjectMonad.ptr_kinds_ptr_kinds_M
         \<open>\<And>thesis. (\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
         get_child_nodes_ptr_in_heap returns_result_eq select_result_I2)
 
   let ?P = "(\<lambda>ptr. get_child_nodes ptr \<bind> (\<lambda>children. return (child \<in> set children)))"
   let ?filter = "filter_M ?P ptrs"
 
   have "h \<turnstile> ok ?filter"
     using ptrs type_wf
     using get_child_nodes_ok
     apply(auto intro!: filter_M_is_OK_I bind_is_OK_pure_I get_child_nodes_ok simp add: bind_pure_I)[1]
     using assms(4) local.known_ptrs_known_ptr by blast
   then obtain parent_ptrs where parent_ptrs: "h \<turnstile> ?filter \<rightarrow>\<^sub>r parent_ptrs"
     by auto
 
   have h5: "\<exists>!x. x \<in> set ptrs \<and> h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
     apply(auto intro!: bind_pure_returns_result_I)[1]
     using heap_is_wellformed_one_parent
   proof -
     have "h \<turnstile> (return (child \<in> set children)::((_) heap, exception, bool) prog) \<rightarrow>\<^sub>r True"
       by (simp add: assms(3))
     then show
       "\<exists>z. z \<in> set ptrs \<and> h \<turnstile> Heap_Error_Monad.bind (get_child_nodes z)
                                (\<lambda>ns. return (child \<in> set ns)) \<rightarrow>\<^sub>r True"
       by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I
           local.get_child_nodes_pure select_result_I2)
   next
     fix x y
     assume 0: "x \<in> set ptrs"
       and 1: "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
       and 2: "y \<in> set ptrs"
       and 3: "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes y)
                   (\<lambda>children. return (child \<in> set children)) \<rightarrow>\<^sub>r True"
       and 4: "(\<And>h ptr children ptr' children'. 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')"
     then show "x = y"
       by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed
           return_returns_result)
   qed
 
   have "child |\<in>| node_ptr_kinds h"
     using heap_is_wellformed_children_in_heap heap_is_wellformed assms(2) assms(3)
     by fast
   moreover have "parent_ptrs = [ptr]"
     apply(rule filter_M_ex1[OF parent_ptrs h1 h5])
     using ptrs assms(2) assms(3)
     by(auto simp add: object_ptr_kinds_M_defs bind_pure_I intro!: bind_pure_returns_result_I)
   ultimately  show ?thesis
     using ptrs parent_ptrs
     by(auto simp add: bind_pure_I get_parent_def
         elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *)
 qed
 
 lemma parent_child_rel_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
   shows "(parent, cast child_node) \<in> parent_child_rel h"
   using assms parent_child_rel_child get_parent_child_dual by auto
 
 lemma heap_wellformed_induct [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
     and step: "\<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> P parent"
   shows "P ptr"
 proof -
   fix ptr
   have "wf ((parent_child_rel h)\<inverse>)"
     by (simp add: assms(1) finite_acyclic_wf_converse parent_child_rel_acyclic parent_child_rel_finite)
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less parent)
     then show ?case
       using assms parent_child_rel_child
       by (meson converse_iff)
   qed
 qed
 
 lemma heap_wellformed_induct2 [consumes 3, case_names not_in_heap empty_children step]:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
     and not_in_heap: "\<And>parent. parent |\<notin>| object_ptr_kinds h \<Longrightarrow> P parent"
     and empty_children: "\<And>parent. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r [] \<Longrightarrow> P parent"
     and step: "\<And>parent children child. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children
                \<Longrightarrow> child \<in> set children \<Longrightarrow> P (cast child) \<Longrightarrow> P parent"
   shows "P ptr"
 proof(insert assms(1), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
   proof(cases "parent |\<in>| object_ptr_kinds h")
     case True
     then obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
       using get_child_nodes_ok assms(2) assms(3)
       by (meson is_OK_returns_result_E local.known_ptrs_known_ptr)
     then show ?thesis
     proof (cases "children = []")
       case True
       then show ?thesis
         using children empty_children
         by simp
     next
       case False
       then show ?thesis
         using assms(6) children last_in_set step.hyps by blast
     qed
   next
     case False
     then show ?thesis
       by (simp add: not_in_heap)
   qed
 qed
 
 lemma heap_wellformed_induct_rev [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
     and step: "\<And>child. (\<And>parent child_node. cast child_node = child
                \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent) \<Longrightarrow> P child"
   shows "P ptr"
 proof -
   fix ptr
   have "wf ((parent_child_rel h))"
     by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite
         wf_iff_acyclic_if_finite)
 
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less child)
     show ?case
       using assms get_parent_child_dual
       by (metis less.hyps parent_child_rel_parent)
   qed
 qed
 end
 
 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]
 
 
 locale l_get_parent_wf2\<^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 parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
   + 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 parent_child_rel
   for known_ptr :: "(_::linorder) 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 get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_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 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
 lemma preserves_wellformedness_writes_needed:
   assumes heap_is_wellformed: "heap_is_wellformed h"
     and "h \<turnstile> f \<rightarrow>\<^sub>h h'"
     and "writes SW f h h'"
     and preserved_get_child_nodes:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                       \<Longrightarrow> \<forall>object_ptr. \<forall>r \<in> get_child_nodes_locs object_ptr. r h h'"
     and preserved_get_disconnected_nodes:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                       \<Longrightarrow> \<forall>document_ptr. \<forall>r \<in> get_disconnected_nodes_locs document_ptr. r h h'"
     and preserved_object_pointers:
     "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
                      \<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
   shows "heap_is_wellformed h'"
 proof -
   have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'"
     using assms(2) assms(3) object_ptr_kinds_preserved preserved_object_pointers by blast
   then have object_ptr_kinds_eq:
     "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     by auto
   have children_eq:
     "\<And>ptr children. 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 assms(3) assms(2)])
     using preserved_get_child_nodes by fast
   then have children_eq2: "\<And>ptr. |h \<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:
     "\<And>document_ptr disconnected_nodes.
         h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
                              = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads assms(3) assms(2)])
     using preserved_get_disconnected_nodes by fast
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r
                             = |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     using select_result_eq by force
   have get_parent_eq: "\<And>ptr parent. h \<turnstile> get_parent ptr \<rightarrow>\<^sub>r parent = h' \<turnstile> get_parent ptr \<rightarrow>\<^sub>r parent"
     apply(rule reads_writes_preserved[OF get_parent_reads assms(3) assms(2)])
     using preserved_get_child_nodes preserved_object_pointers unfolding get_parent_locs_def by fast
   have "a_acyclic_heap h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
   proof
     fix x
     assume "x \<in> parent_child_rel h'"
     then show "x \<in> parent_child_rel h"
       by(simp add: parent_child_rel_def  children_eq2 object_ptr_kinds_eq3)
   qed
   then have "a_acyclic_heap h'"
     using \<open>a_acyclic_heap h\<close> acyclic_heap_def acyclic_subset by blast
 
   moreover have "a_all_ptrs_in_heap h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   then have "a_all_ptrs_in_heap h'"
     by (simp add: children_eq2 disconnected_nodes_eq2 document_ptr_kinds_eq3
         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_eq3 object_ptr_kinds_eq3)
 
   moreover have h0: "a_distinct_lists h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   have h1: "map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))
          = map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))"
     by (simp add: children_eq2 object_ptr_kinds_eq3)
   have h2: "map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                (sorted_list_of_set (fset (document_ptr_kinds h)))
           = map (\<lambda>document_ptr. |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                 (sorted_list_of_set (fset (document_ptr_kinds h')))"
     using disconnected_nodes_eq document_ptr_kinds_eq2 select_result_eq by force
   have "a_distinct_lists h'"
     using h0
     by(simp add: a_distinct_lists_def h1 h2)
 
   moreover have "a_owner_document_valid h"
     using heap_is_wellformed by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2
         object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3)
   ultimately show ?thesis
     by (simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_get_parent_wf2?: 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 parent_child_rel get_disconnected_nodes
   get_disconnected_nodes_locs
   using l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
   by (simp add: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 
 declare l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 locale l_get_parent_wf = l_type_wf + l_known_ptrs  + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_get_parent_defs +
   assumes child_parent_dual:
     "heap_is_wellformed h
     \<Longrightarrow> type_wf h
     \<Longrightarrow> known_ptrs h
     \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
     \<Longrightarrow> child \<in> set children
     \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
   assumes heap_wellformed_induct [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> P parent)
     \<Longrightarrow> P ptr"
   assumes heap_wellformed_induct_rev [consumes 1, case_names step]:
     "heap_is_wellformed h
     \<Longrightarrow> (\<And>child. (\<And>parent child_node. cast child_node = child
     \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent) \<Longrightarrow> P child)
     \<Longrightarrow> P ptr"
   assumes parent_child_rel_parent: "heap_is_wellformed h
     \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent
     \<Longrightarrow> (parent, cast child_node) \<in> parent_child_rel h"
 
 lemma get_parent_wf_is_l_get_parent_wf [instances]:
   "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel
   get_child_nodes get_parent"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def)[1]
   using child_parent_dual heap_wellformed_induct heap_wellformed_induct_rev parent_child_rel_parent
   by metis+
 
 
 
 subsection \<open>get\_disconnected\_nodes\<close>
 
 
 
 subsection \<open>set\_disconnected\_nodes\<close>
 
 
 subsubsection \<open>get\_disconnected\_nodes\<close>
 
 locale l_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
   type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs
   + l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     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 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 heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     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"
 begin
 
 lemma remove_from_disconnected_nodes_removes:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes"
   assumes "h \<turnstile> set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \<rightarrow>\<^sub>h h'"
   assumes "h' \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes'"
   shows "node_ptr \<notin> set disc_nodes'"
   using assms
   by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct
       set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1)
       returns_result_eq)
 end
 
 locale l_set_disconnected_nodes_get_disconnected_nodes_wf = l_heap_is_wellformed
   + l_set_disconnected_nodes_get_disconnected_nodes +
   assumes remove_from_disconnected_nodes_removes:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes
                           \<Longrightarrow> h \<turnstile> set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> h' \<turnstile> get_disconnected_nodes ptr \<rightarrow>\<^sub>r disc_nodes'
                           \<Longrightarrow> node_ptr \<notin> set disc_nodes'"
 
 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
   parent_child_rel get_child_nodes
   using instances
   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)
 declare 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_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 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 remove_from_disconnected_nodes_removes apply fast
   done
 
 
 subsection \<open>get\_root\_node\<close>
 
 locale l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed
   type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   + 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
   + 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_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
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     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_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_ancestors :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog"
     and get_ancestors_locs :: "((_) 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"
 
 begin
 lemma get_ancestors_reads:
   assumes "heap_is_wellformed h"
   shows "reads get_ancestors_locs (get_ancestors node_ptr) h h'"
 proof (insert assms(1), induct rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
     using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def]
     apply(simp (no_asm) add: get_ancestors_def)
     by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers
         intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
         reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads]
         split: option.splits)
 qed
 
 lemma get_ancestors_ok:
   assumes "heap_is_wellformed h"
     and "ptr |\<in>| object_ptr_kinds h"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h \<turnstile> ok (get_ancestors ptr)"
 proof (insert assms(1) assms(2), induct rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
     using assms(3) assms(4)
     apply(simp (no_asm) add: get_ancestors_def)
     apply(simp add: assms(1) get_parent_parent_in_heap)
     by(auto intro!: bind_is_OK_pure_I bind_pure_I get_parent_ok split: option.splits)
 qed
 
 lemma get_root_node_ptr_in_heap:
   assumes "h \<turnstile> ok (get_root_node ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   unfolding get_root_node_def
   using get_ancestors_ptr_in_heap
   by auto
 
 
 lemma get_root_node_ok:
   assumes "heap_is_wellformed h" "known_ptrs h" "type_wf h"
     and "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_root_node ptr)"
   unfolding get_root_node_def
   using assms get_ancestors_ok
   by auto
 
 
 lemma get_ancestors_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent"
   shows "h \<turnstile> get_ancestors (cast child) \<rightarrow>\<^sub>r (cast child) # parent # ancestors
      \<longleftrightarrow> h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
 proof
   assume a1: "h \<turnstile> get_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) \<rightarrow>\<^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 # parent # ancestors"
   then have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap (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))
           (\<lambda>_. Heap_Error_Monad.bind (get_parent child)
               (\<lambda>x. Heap_Error_Monad.bind (case x of None \<Rightarrow> return [] | Some x \<Rightarrow> get_ancestors x)
                (\<lambda>ancestors. 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 child # ancestors))))
         \<rightarrow>\<^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 # parent # ancestors"
     by(simp add: get_ancestors_def)
   then show "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
     using assms(2) apply(auto elim!: bind_returns_result_E2 split: option.splits)[1]
     using returns_result_eq by fastforce
 next
   assume "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r parent # ancestors"
   then show "h \<turnstile> get_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) \<rightarrow>\<^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 # parent # ancestors"
     using assms(2)
     apply(simp (no_asm) add: get_ancestors_def)
     apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I
         local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust
         select_result_I)
 qed
 
 
 lemma get_ancestors_never_empty:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors"
   shows "ancestors \<noteq> []"
 proof(insert assms(2), induct arbitrary: ancestors rule: heap_wellformed_induct_rev[OF assms(1)])
   case (1 child)
   then 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
     then show ?case
       apply(simp add: get_ancestors_def)
       by(auto elim!: bind_returns_result_E2 split: option.splits)
   next
     case (Some child_node)
     then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r parent_opt"
       apply(simp add: get_ancestors_def)
       by(auto elim!: bind_returns_result_E2 split: option.splits)
     with Some show ?case
     proof(induct parent_opt)
       case None
       then show ?case
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits)
     next
       case (Some option)
       then show ?case
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits)
     qed
   qed
 qed
 
 
 
 lemma get_ancestors_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors 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)
   case (step child)
   have "child |\<in>| object_ptr_kinds h"
     using get_ancestors_ptr_in_heap step(2) by auto
       (*  then have "h \<turnstile> check_in_heap child \<rightarrow>\<^sub>r ()"
     using returns_result_select_result by force *)
   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
     then have "ancestors = [child]"
       using step(2) step(3)
       by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2)
     show ?case
       using step(2) step(3)
       apply(auto simp add: \<open>ancestors = [child]\<close>)[1]
       using assms(4) returns_result_eq by fastforce
   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(2) step(3) s1
         apply(simp add: get_ancestors_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       show ?case
         using step(2) step(3)
         apply(auto simp add: \<open>ancestors = [child]\<close>)[1]
         using assms(4) returns_result_eq by fastforce
     next
       case (Some parent)
       have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap child)
           (\<lambda>_. Heap_Error_Monad.bind
                  (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 child of None \<Rightarrow> return []
                   | Some node_ptr \<Rightarrow> Heap_Error_Monad.bind (get_parent node_ptr)
                                          (\<lambda>parent_ptr_opt. case parent_ptr_opt of None \<Rightarrow> return []
                                                                         | Some x \<Rightarrow> get_ancestors x))
                  (\<lambda>ancestors. return (child # ancestors)))
     \<rightarrow>\<^sub>r  ancestors"
         using step(2)
         by(simp add: get_ancestors_def)
       moreover obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
         using calculation
         by(auto elim!: bind_returns_result_E2 split: option.splits)
       ultimately have "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors"
         using s1 Some
         by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       show ?case
         using step(1)[OF s1[symmetric, simplified] Some \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors\<close>]
           step(3)
         apply(auto simp add: tl_ancestors)[1]
         by (metis assms(4) insert_iff list.simps(15) local.step(2) returns_result_eq tl_ancestors)
     qed
   qed
 qed
 
 lemma get_ancestors_also_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors 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 (cast child) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(4) get_ancestors_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_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_subset by blast
 qed
 
 lemma get_ancestors_obtains_children:
   assumes "heap_is_wellformed h"
     and "ancestor \<noteq> ptr"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
   obtains children ancestor_child where "h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children"
     and "ancestor_child \<in> set children" and "cast ancestor_child \<in> set ancestors"
 proof -
   assume 0: "(\<And>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 ancestors
         \<Longrightarrow> thesis)"
   have "\<exists>child. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ancestor \<and> cast child \<in> set ancestors"
   proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors
       rule: heap_wellformed_induct_rev)
     case (step child)
     have "child |\<in>| object_ptr_kinds h"
       using get_ancestors_ptr_in_heap step(4) by auto
     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
       then have "ancestors = [child]"
         using step(3) step(4)
         by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2)
       show ?case
         using step(2) step(3) step(4)
         by(auto simp add: \<open>ancestors = [child]\<close>)
     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]
         using get_parent_ok known_ptrs type_wf
         by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute
             node_ptr_kinds_commutes)
       then show ?case
       proof (induct parent_opt)
         case None
         then have "ancestors = [child]"
           using step(2) step(3) step(4) s1
           apply(simp add: get_ancestors_def)
           by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
         show ?case
           using step(2) step(3) step(4)
           by(auto simp add: \<open>ancestors = [child]\<close>)
       next
         case (Some parent)
         have "h \<turnstile> Heap_Error_Monad.bind (check_in_heap child)
             (\<lambda>_. Heap_Error_Monad.bind
                    (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 child of None \<Rightarrow> return []
                     | Some node_ptr \<Rightarrow> Heap_Error_Monad.bind (get_parent node_ptr)
                        (\<lambda>parent_ptr_opt. case parent_ptr_opt of None \<Rightarrow> return []
                                                               | Some x \<Rightarrow> get_ancestors x))
                    (\<lambda>ancestors. return (child # ancestors)))
       \<rightarrow>\<^sub>r  ancestors"
           using step(4)
           by(simp add: get_ancestors_def)
         moreover obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
           using calculation
           by(auto elim!: bind_returns_result_E2 split: option.splits)
         ultimately have "h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors"
           using s1 Some
           by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
             (* have "ancestor \<noteq> parent" *)
         have "ancestor \<in> set tl_ancestors"
           using tl_ancestors step(2) step(3) by auto
         show ?case
         proof (cases "ancestor \<noteq> parent")
           case True
           show ?thesis
             using step(1)[OF s1[symmetric, simplified] Some True
                 \<open>ancestor \<in> set tl_ancestors\<close> \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r tl_ancestors\<close>]
             using tl_ancestors by auto
         next
           case False
           have "child \<in> set ancestors"
             using step(4) get_ancestors_ptr by simp
           then show ?thesis
             using Some False s1[symmetric] by(auto)
         qed
       qed
     qed
   qed
   then obtain child where child: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ancestor"
     and in_ancestors: "cast child \<in> set ancestors"
     by auto
   then obtain children where
     children: "h \<turnstile> get_child_nodes ancestor \<rightarrow>\<^sub>r children" and
     child_in_children: "child \<in> set children"
     using get_parent_child_dual by blast
   show thesis
     using 0[OF children child_in_children] child assms(3) in_ancestors by blast
 qed
 
 lemma get_ancestors_parent_child_rel:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "(ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 proof (safe)
   assume 3: "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   show "ptr \<in> set ancestors"
   proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)])
     case (1 ptr)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by (metis (no_types, lifting) assms(2) bind_returns_result_E get_ancestors_def
             in_set_member member_rec(1) return_returns_result)
     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(2)] \<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 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 local.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 known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr
               local.parent_child_rel_child ptr_child ptr_child_ptr_child_node
               returns_result_select_result type_wf)
         ultimately show ?thesis
           using a1 get_child_nodes_ok type_wf known_ptrs
           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 known_ptrs type_wf by blast
       ultimately show ?thesis
         using get_ancestors_also_parent assms type_wf by blast
     qed
   qed
 next
   assume 3: "ptr \<in> set ancestors"
   show "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)])
     case (1 ptr)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by simp
     next
       case False
       then obtain children ptr_child_node where
         children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children" and
         ptr_child_node: "ptr_child_node \<in> set children" and
         ptr_child_node_in_ancestors: "cast ptr_child_node \<in> set ancestors"
         using 1(2) assms(2) get_ancestors_obtains_children assms(1)
         using known_ptrs type_wf by blast
       then 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 1(1) by blast
 
       moreover have "(ptr, cast ptr_child_node) \<in> parent_child_rel h"
         using children ptr_child_node assms(1) parent_child_rel_child_nodes2
         using child_parent_dual known_ptrs parent_child_rel_parent type_wf
         by blast
 
       ultimately show ?thesis
         by auto
     qed
   qed
 qed
 
 lemma get_root_node_parent_child_rel:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_root_node child \<rightarrow>\<^sub>r root"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "(root, child) \<in> (parent_child_rel h)\<^sup>*"
   using assms get_ancestors_parent_child_rel
   apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1]
   using get_ancestors_never_empty last_in_set by blast
 
 
 lemma get_ancestors_eq:
   assumes "heap_is_wellformed h"
     and "heap_is_wellformed h'"
     and "\<And>object_ptr w. object_ptr \<noteq> ptr \<Longrightarrow> w \<in> get_child_nodes_locs object_ptr \<Longrightarrow> w h h'"
     and pointers_preserved: "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
     and known_ptrs: "known_ptrs h"
     and known_ptrs': "known_ptrs h'"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and type_wf: "type_wf h"
     and type_wf': "type_wf h'"
   shows "h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
 proof -
   have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'"
     using pointers_preserved object_ptr_kinds_preserved_small by blast
   then 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"
     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)
   have "h' \<turnstile> ok (get_ancestors ptr)"
     using get_ancestors_ok get_ancestors_ptr_in_heap object_ptr_kinds_eq3 assms(1) known_ptrs
       known_ptrs' assms(2) assms(7) type_wf'
     by blast
   then obtain ancestors' where ancestors': "h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors'"
     by auto
 
   obtain root where root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   proof -
     assume 0: "(\<And>root. h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow> thesis)"
     show thesis
       apply(rule 0)
       using assms(7)
       by(auto simp add: get_root_node_def elim!: bind_returns_result_E2 split: option.splits)
   qed
 
   have children_eq:
     "\<And>p children. p \<noteq> ptr \<Longrightarrow> h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads assms(3)
     apply(simp add: reads_def reflp_def transp_def preserved_def)
     by blast
 
   have "acyclic (parent_child_rel h)"
     using assms(1) local.parent_child_rel_acyclic by auto
   have "acyclic (parent_child_rel h')"
     using assms(2) local.parent_child_rel_acyclic by blast
   have 2: "\<And>c parent_opt. 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 c \<in> set ancestors \<inter> set ancestors'
           \<Longrightarrow> h \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt = h' \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt"
   proof -
     fix c parent_opt
     assume 1: " 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 c \<in> set ancestors \<inter> set ancestors'"
 
     obtain ptrs where ptrs: "h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
       by simp
 
     let ?P = "(\<lambda>ptr. Heap_Error_Monad.bind (get_child_nodes ptr) (\<lambda>children. return (c \<in> set children)))"
     have children_eq_True: "\<And>p. p \<in> set ptrs \<Longrightarrow> h \<turnstile> ?P p \<rightarrow>\<^sub>r True \<longleftrightarrow> h' \<turnstile> ?P p \<rightarrow>\<^sub>r True"
     proof -
       fix p
       assume "p \<in> set ptrs"
       then show "h \<turnstile> ?P p \<rightarrow>\<^sub>r True \<longleftrightarrow> h' \<turnstile> ?P p \<rightarrow>\<^sub>r True"
       proof (cases "p = ptr")
         case True
         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 c, ptr) \<in> (parent_child_rel h)\<^sup>*"
           using get_ancestors_parent_child_rel 1 assms by blast
         then have "(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 c) \<notin> (parent_child_rel h)"
         proof (cases "cast c = ptr")
           case True
           then show ?thesis
             using \<open>acyclic (parent_child_rel h)\<close> by(auto simp add: acyclic_def)
         next
           case False
           then have "(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 c) \<notin> (parent_child_rel h)\<^sup>*"
             using \<open>acyclic (parent_child_rel h)\<close> False rtrancl_eq_or_trancl rtrancl_trancl_trancl
               \<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 c, ptr) \<in> (parent_child_rel h)\<^sup>*\<close>
             by (metis acyclic_def)
           then show ?thesis
             using r_into_rtrancl by auto
         qed
         obtain children where children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
           using type_wf
           by (metis \<open>h' \<turnstile> ok get_ancestors ptr\<close> assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok
               heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr
               object_ptr_kinds_eq3)
         then have "c \<notin> set children"
           using \<open>(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 c) \<notin> (parent_child_rel h)\<close> assms(1)
           using parent_child_rel_child_nodes2
           using child_parent_dual known_ptrs parent_child_rel_parent
             type_wf by blast
         with children have "h \<turnstile> ?P p \<rightarrow>\<^sub>r False"
           by(auto simp add: True)
 
         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 c, ptr) \<in> (parent_child_rel h')\<^sup>*"
           using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf
             type_wf' by blast
         then have "(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 c) \<notin> (parent_child_rel h')"
         proof (cases "cast c = ptr")
           case True
           then show ?thesis
             using \<open>acyclic (parent_child_rel h')\<close> by(auto simp add: acyclic_def)
         next
           case False
           then have "(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 c) \<notin> (parent_child_rel h')\<^sup>*"
             using \<open>acyclic (parent_child_rel h')\<close> False rtrancl_eq_or_trancl rtrancl_trancl_trancl
               \<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 c, ptr) \<in> (parent_child_rel h')\<^sup>*\<close>
             by (metis acyclic_def)
           then show ?thesis
             using r_into_rtrancl by auto
         qed
         then have "(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 c) \<notin> (parent_child_rel h')"
           using r_into_rtrancl by auto
         obtain children' where children': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'"
           using  type_wf  type_wf'
           by (meson \<open>h' \<turnstile> ok (get_ancestors ptr)\<close> assms(2) get_ancestors_ptr_in_heap
               get_child_nodes_ok is_OK_returns_result_E known_ptrs'
               local.known_ptrs_known_ptr)
         then have "c \<notin> set children'"
           using \<open>(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 c) \<notin> (parent_child_rel h')\<close> assms(2)  type_wf  type_wf'
           using parent_child_rel_child_nodes2 child_parent_dual known_ptrs' parent_child_rel_parent
           by auto
         with children' have "h' \<turnstile> ?P p \<rightarrow>\<^sub>r False"
           by(auto simp add: True)
 
         ultimately show ?thesis
           by (metis returns_result_eq)
       next
         case False
         then show ?thesis
           using children_eq ptrs
           by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E
               get_child_nodes_pure return_returns_result)
       qed
     qed
     have "\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                      \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                      \<bind> (\<lambda>children. return (c \<in> set children)))"
       using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf  type_wf'
       by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I
           get_child_nodes_ok get_child_nodes_pure known_ptrs'
           local.known_ptrs_known_ptr return_ok select_result_I2)
     have children_eq_False:
       "\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False = h' \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
     proof
       fix pa
       assume "pa \<in> set ptrs"
         and "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
       have "h \<turnstile> ok (get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))
            \<Longrightarrow> h' \<turnstile> ok ( get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))"
         using \<open>pa \<in> set ptrs\<close> \<open>\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                     \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                     \<bind> (\<lambda>children. return (c \<in> set children)))\<close>
         by auto
       moreover have "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False
         \<Longrightarrow> h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         by (metis (mono_tags, lifting) \<open>\<And>pa. pa \<in> set ptrs
               \<Longrightarrow> h \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True = h' \<turnstile> get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True\<close> \<open>pa \<in> set ptrs\<close>
             calculation is_OK_returns_result_I returns_result_eq returns_result_select_result)
       ultimately show "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         using \<open>h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False\<close>
         by auto
     next
       fix pa
       assume "pa \<in> set ptrs"
         and "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
       have "h' \<turnstile> ok (get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))
             \<Longrightarrow> h \<turnstile> ok ( get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)))"
         using \<open>pa \<in> set ptrs\<close> \<open>\<And>pa. pa \<in> set ptrs
               \<Longrightarrow> h \<turnstile> ok (get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children))) = h' \<turnstile> ok ( get_child_nodes pa
                   \<bind> (\<lambda>children. return (c \<in> set children)))\<close>
         by auto
       moreover have "h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False
                   \<Longrightarrow> h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         by (metis (mono_tags, lifting)
             \<open>\<And>pa. pa \<in> set ptrs \<Longrightarrow> h \<turnstile> get_child_nodes pa
                         \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True = h' \<turnstile> get_child_nodes pa
                         \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r True\<close> \<open>pa \<in> set ptrs\<close>
             calculation is_OK_returns_result_I returns_result_eq returns_result_select_result)
       ultimately show "h \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False"
         using \<open>h' \<turnstile> get_child_nodes pa \<bind> (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r False\<close> by blast
     qed
 
     have filter_eq: "\<And>xs. h \<turnstile> filter_M ?P ptrs \<rightarrow>\<^sub>r xs = h' \<turnstile> filter_M ?P ptrs \<rightarrow>\<^sub>r xs"
     proof (rule filter_M_eq)
       show
         "\<And>xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children))) h"
         by(auto intro!: bind_pure_I)
     next
       show
         "\<And>xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children))) h'"
         by(auto intro!: bind_pure_I)
     next
       fix xs b x
       assume 0: "x \<in> set ptrs"
       then show "h \<turnstile> Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r b
               = h' \<turnstile> Heap_Error_Monad.bind (get_child_nodes x) (\<lambda>children. return (c \<in> set children)) \<rightarrow>\<^sub>r b"
         apply(induct b)
         using children_eq_True apply blast
         using children_eq_False apply blast
         done
     qed
 
     show "h \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt = h' \<turnstile> get_parent c \<rightarrow>\<^sub>r parent_opt"
       apply(simp add: get_parent_def)
       apply(rule bind_cong_2)
          apply(simp)
         apply(simp)
        apply(simp add: check_in_heap_def node_ptr_kinds_def object_ptr_kinds_eq3)
       apply(rule bind_cong_2)
          apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
         apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
        apply(auto simp add: object_ptr_kinds_M_eq object_ptr_kinds_eq3)[1]
       apply(rule bind_cong_2)
          apply(auto intro!: filter_M_pure_I bind_pure_I)[1]
         apply(auto intro!: filter_M_pure_I bind_pure_I)[1]
        apply(auto simp add: filter_eq (* dest!: returns_result_eq[OF ptrs] *))[1]
       using filter_eq ptrs apply auto[1]
       using filter_eq ptrs by auto
   qed
 
   have "ancestors = ancestors'"
   proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors'
       rule: heap_wellformed_induct_rev)
     case (step child)
     show ?case
       using step(2) step(3) step(4)
       apply(simp add: get_ancestors_def)
       apply(auto intro!: elim!: bind_returns_result_E2 split: option.splits)[1]
       using returns_result_eq apply fastforce
        apply (meson option.simps(3) returns_result_eq)
       by (metis IntD1 IntD2 option.inject returns_result_eq step.hyps)
   qed
   then show ?thesis
     using assms(5) ancestors'
     by simp
 qed
 
 lemma get_ancestors_remains_not_in_ancestors:
   assumes "heap_is_wellformed h"
     and "heap_is_wellformed h'"
     and "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
     and "h' \<turnstile> get_ancestors 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 "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(6), induct ptr arbitrary: ancestors ancestors'
       rule: heap_wellformed_induct_rev)
     case (step child)
     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 "node \<noteq> child"
       using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs
       using type_wf type_wf'
       by blast
     then show ?case
       using step(2) step(3)
       apply(simp add: get_ancestors_def)
       using step(4)
       apply(auto elim!: bind_returns_result_E2 split: option.splits)[1]
       using 1
        apply (meson option.distinct(1) returns_result_eq)
       by (metis "1" option.inject returns_result_eq step.hyps)
   qed
 qed
 
 lemma get_ancestors_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors 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 x \<rightarrow>\<^sub>r a # ancestors"
     by(auto simp add: get_ancestors_def[of a] elim!: bind_returns_result_E2 split: option.splits)
   then have "x = a"
     by(auto simp add: get_ancestors_def[of x] elim!: bind_returns_result_E2 split: option.splits)
   then show ?case
     using Cons.hyps Cons.prems(2) get_ancestors_ptr_in_heap x
     by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap
         is_OK_returns_result_I)
 qed
 
 
 lemma get_ancestors_prefix:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
   assumes "ptr' \<in> set ancestors"
   assumes "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
   shows "\<exists>pre. ancestors = pre @ ancestors'"
 proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors'
     rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
   proof (cases "parent \<noteq> ptr" )
     case True
 
     then obtain children ancestor_child where "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
       and "ancestor_child \<in> set children" and "cast ancestor_child \<in> set ancestors"
       using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast
     then have "h \<turnstile> get_parent ancestor_child \<rightarrow>\<^sub>r Some parent"
       using assms(1) assms(2) assms(3) child_parent_dual by blast
     then have "h \<turnstile> get_ancestors (cast ancestor_child) \<rightarrow>\<^sub>r cast ancestor_child # ancestors'"
       apply(simp add: get_ancestors_def)
       using \<open>h \<turnstile> get_ancestors parent \<rightarrow>\<^sub>r ancestors'\<close> get_parent_ptr_in_heap
       by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I)
     then show ?thesis
       using step(1) \<open>h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children\<close> \<open>ancestor_child \<in> set children\<close>
         \<open>cast ancestor_child \<in> set ancestors\<close> \<open>h \<turnstile> get_ancestors (cast ancestor_child) \<rightarrow>\<^sub>r cast ancestor_child # ancestors'\<close>
       by fastforce
   next
     case False
     then show ?thesis
       by (metis append_Nil assms(4) returns_result_eq step.prems(2))
   qed
 qed
 
 
 lemma get_ancestors_same_root_node:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors"
   assumes "ptr' \<in> set ancestors"
   assumes "ptr'' \<in> set ancestors"
   shows "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr \<longleftrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
 proof -
   have "ptr' |\<in>| object_ptr_kinds h"
     by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children
         get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I)
   then obtain ancestors' where ancestors': "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
     by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E)
   then have "\<exists>pre. ancestors = pre @ ancestors'"
     using get_ancestors_prefix assms by blast
   moreover have "ptr'' |\<in>| object_ptr_kinds h"
     by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children
         get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I)
   then obtain ancestors'' where ancestors'': "h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''"
     by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E)
   then have "\<exists>pre. ancestors = pre @ ancestors''"
     using get_ancestors_prefix assms by blast
   ultimately show ?thesis
     using ancestors' ancestors''
     apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I)[1]
      apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR
         returns_result_eq)
     by (metis assms(1) get_ancestors_never_empty last_appendR returns_result_eq)
 qed
 
 lemma get_root_node_parent_same:
   assumes "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr"
   shows "h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root \<longleftrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
 proof
   assume 1: " h \<turnstile> get_root_node (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 root"
   show "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     using 1[unfolded get_root_node_def] assms
     apply(simp add: get_ancestors_def)
     apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I split: option.splits)[1]
     using returns_result_eq apply fastforce
     using get_ancestors_ptr by fastforce
 next
   assume 1: " h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
   show "h \<turnstile> get_root_node (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 root"
     apply(simp add: get_root_node_def)
     using assms 1
     apply(simp add: get_ancestors_def)
     apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
         intro!: bind_pure_returns_result_I split: option.splits)[1]
      apply (simp add: check_in_heap_def is_OK_returns_result_I)
     using get_ancestors_ptr get_parent_ptr_in_heap
     apply (simp add: is_OK_returns_result_I)
     by (meson list.distinct(1) list.set_cases local.get_ancestors_ptr)
 qed
 
 lemma get_root_node_same_no_parent:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node 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)
   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 have "c = cast child"
       using step(2)
       by(auto simp add: get_root_node_def get_ancestors_def[of c] elim!: bind_returns_result_E2)
     then show ?thesis
       using None by auto
   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"
       by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap
           is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute
           node_ptr_kinds_commutes returns_result_select_result step.prems)
     then show ?thesis
     proof(induct parent_opt)
       case None
       then show ?case
         using Some get_root_node_no_parent returns_result_eq step.prems by fastforce
     next
       case (Some parent)
       then show ?case
         using step s
         apply(auto simp add: get_root_node_def get_ancestors_def[of c]
             elim!: bind_returns_result_E2 split: option.splits list.splits)[1]
         using get_root_node_parent_same step.hyps step.prems by auto
     qed
   qed
 qed
 
 lemma get_root_node_not_node_same:
   assumes "ptr |\<in>| object_ptr_kinds h"
   assumes "\<not>is_node_ptr_kind ptr"
   shows "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r ptr"
   using assms
   apply(simp add: get_root_node_def get_ancestors_def)
   by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2
       intro!: bind_pure_returns_result_I split: option.splits)
 
 
 lemma get_root_node_root_in_heap:
   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 "root |\<in>| object_ptr_kinds h"
   using assms
   apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1]
   by (simp add: get_ancestors_never_empty get_ancestors_ptrs_in_heap)
 
 
 lemma get_root_node_same_no_parent_parent_child_rel:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r ptr'"
   shows "\<not>(\<exists>p. (p, ptr') \<in> (parent_child_rel h))"
   by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent
       l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok
       local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr
       local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq
       returns_result_select_result)
 
 end
 
 
 locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs
   + l_get_child_nodes_defs + l_get_parent_defs +
   assumes get_ancestors_never_empty:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ancestors \<noteq> []"
   assumes get_ancestors_ok:
     "heap_is_wellformed h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> h \<turnstile> ok (get_ancestors ptr)"
   assumes get_ancestors_reads:
     "heap_is_wellformed h \<Longrightarrow> reads get_ancestors_locs (get_ancestors node_ptr) h h'"
   assumes get_ancestors_ptrs_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ptr' \<in> set ancestors
                           \<Longrightarrow> ptr' |\<in>| object_ptr_kinds h"
   assumes get_ancestors_remains_not_in_ancestors:
     "heap_is_wellformed h \<Longrightarrow> heap_is_wellformed h' \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors
                           \<Longrightarrow> h' \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors'
                           \<Longrightarrow> (\<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)
                           \<Longrightarrow> node \<notin> set ancestors
                           \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> type_wf h' \<Longrightarrow> node \<notin> set ancestors'"
   assumes get_ancestors_also_parent:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors some_ptr \<rightarrow>\<^sub>r ancestors
                           \<Longrightarrow> cast child_node \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> type_wf h
                           \<Longrightarrow> known_ptrs h \<Longrightarrow> parent \<in> set ancestors"
   assumes get_ancestors_obtains_children:
     "heap_is_wellformed h \<Longrightarrow> ancestor \<noteq> ptr \<Longrightarrow> ancestor \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> (\<And>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"
   assumes get_ancestors_parent_child_rel:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_ancestors child \<rightarrow>\<^sub>r ancestors \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> (ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> ptr \<in> set ancestors"
 
 locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf
   + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs +
   assumes get_root_node_ok:
     "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h
                           \<Longrightarrow> h \<turnstile> ok (get_root_node ptr)"
   assumes get_root_node_ptr_in_heap:
     "h \<turnstile> ok (get_root_node ptr) \<Longrightarrow> ptr |\<in>| object_ptr_kinds h"
   assumes get_root_node_root_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow> root |\<in>| object_ptr_kinds h"
   assumes get_ancestors_same_root_node:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors \<Longrightarrow> ptr' \<in> set ancestors
                           \<Longrightarrow> ptr'' \<in> set ancestors
                           \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr \<longleftrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
   assumes get_root_node_same_no_parent:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r cast child \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
   assumes get_root_node_parent_same:
     "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some ptr
         \<Longrightarrow> h \<turnstile> get_root_node (cast child) \<rightarrow>\<^sub>r root \<longleftrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
 
 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
   using instances
   by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 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"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def)[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_parent_same apply (blast, blast)
   done
 
 
 subsection \<open>to\_tree\_order\<close>
 
 locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent +
   l_get_parent_wf +
   l_heap_is_wellformed
   (* l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M *)
 begin
 
 lemma to_tree_order_ptr_in_heap:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> ok (to_tree_order ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
 proof(insert assms(1) assms(4), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
     apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_is_OK_E3)[1]
     using get_child_nodes_ptr_in_heap by blast
 qed
 
 lemma to_tree_order_either_ptr_or_in_children:
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "node \<in> set nodes"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and "node \<noteq> ptr"
   obtains child child_to where "child \<in> set children"
     and "h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r child_to" and "node \<in> set child_to"
 proof -
   obtain treeorders where treeorders: "h \<turnstile> map_M to_tree_order (map cast children) \<rightarrow>\<^sub>r treeorders"
     using assms
     apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1]
     using pure_returns_heap_eq returns_result_eq by fastforce
   then have "node \<in> set (concat treeorders)"
     using assms[simplified to_tree_order_def]
     by(auto elim!: bind_returns_result_E4 dest: pure_returns_heap_eq)
   then obtain treeorder where "treeorder \<in> set treeorders"
     and node_in_treeorder: "node \<in> set treeorder"
     by auto
   then obtain child where "h \<turnstile> to_tree_order (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 treeorder"
     and  "child \<in> set children"
     using assms[simplified to_tree_order_def] treeorders
     by(auto elim!: map_M_pure_E2)
   then show ?thesis
     using node_in_treeorder returns_result_eq that by auto
 qed
 
 
 lemma to_tree_order_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   shows "ptr' |\<in>| object_ptr_kinds h"
 proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wellformed_induct)
   case (step parent)
   have "parent |\<in>| object_ptr_kinds h"
     using assms(1) assms(2) assms(3) step.prems(1) to_tree_order_ptr_in_heap by blast
   then obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then have "to = [parent]"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_returns_result_E2)[1]
       by (metis list.distinct(1) list.map_disc_iff list.set_cases map_M_pure_E2 returns_result_eq)
     then show ?thesis
       using \<open>parent |\<in>| object_ptr_kinds h\<close> step.prems(2) by auto
   next
     case False
     note f = this
     then show ?thesis
       using children step to_tree_order_either_ptr_or_in_children
     proof (cases "ptr' = parent")
       case True
       then show ?thesis
         using \<open>parent |\<in>| object_ptr_kinds h\<close> by blast
     next
       case False
       then show ?thesis
         using children step.hyps to_tree_order_either_ptr_or_in_children
         by (metis step.prems(1) step.prems(2))
     qed
   qed
 qed
 
 lemma to_tree_order_ok:
   assumes wellformed: "heap_is_wellformed h"
     and "ptr |\<in>| object_ptr_kinds h"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h \<turnstile> ok (to_tree_order ptr)"
 proof(insert assms(1) assms(2), induct rule: heap_wellformed_induct)
   case (step parent)
   then show ?case
     using assms(3) type_wf
     apply(simp add: to_tree_order_def)
     apply(auto simp add: heap_is_wellformed_def intro!: map_M_ok_I bind_is_OK_pure_I map_M_pure_I)[1]
     using get_child_nodes_ok known_ptrs_known_ptr apply blast
     by (simp add: local.heap_is_wellformed_children_in_heap local.to_tree_order_def wellformed)
 qed
 
 lemma to_tree_order_child_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and "node \<in> set children"
     and "h \<turnstile> to_tree_order (cast node) \<rightarrow>\<^sub>r nodes'"
   shows "set nodes' \<subseteq> set nodes"
 proof
   fix x
   assume a1: "x \<in> set nodes'"
   moreover obtain treeorders
     where treeorders: "h \<turnstile> map_M to_tree_order (map cast children) \<rightarrow>\<^sub>r treeorders"
     using assms(2) assms(3)
     apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1]
     using pure_returns_heap_eq returns_result_eq by fastforce
   then have "nodes' \<in> set treeorders"
     using assms(4) assms(5)
     by(auto elim!: map_M_pure_E dest: returns_result_eq)
   moreover have "set (concat treeorders) \<subseteq> set nodes"
     using treeorders assms(2) assms(3)
     by(auto simp add: to_tree_order_def elim!: bind_returns_result_E4 dest: pure_returns_heap_eq)
   ultimately show "x \<in> set nodes"
     by auto
 qed
 
 lemma to_tree_order_ptr_in_result:
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   shows "ptr \<in> set nodes"
   using assms
   apply(simp add: to_tree_order_def)
   by(auto elim!: bind_returns_result_E2 intro!: map_M_pure_I bind_pure_I)
 
 lemma to_tree_order_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
     and "node \<in> set nodes"
     and "h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "set nodes' \<subseteq> set nodes"
 proof -
   have "\<forall>nodes. h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<longrightarrow> (\<forall>node. node \<in> set nodes
        \<longrightarrow> (\<forall>nodes'. h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<longrightarrow> set nodes' \<subseteq> set nodes))"
   proof(insert assms(1), induct ptr rule: heap_wellformed_induct)
     case (step parent)
     then show ?case
     proof safe
       fix nodes node nodes' x
       assume 1: "(\<And>children child.
              h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow>
              child \<in> set children \<Longrightarrow> \<forall>nodes. h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes
             \<longrightarrow> (\<forall>node. node \<in> set nodes \<longrightarrow> (\<forall>nodes'. h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'
                                               \<longrightarrow> set nodes' \<subseteq> set nodes)))"
         and 2: "h \<turnstile> to_tree_order parent \<rightarrow>\<^sub>r nodes"
         and 3: "node \<in> set nodes"
         and "h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'"
         and "x \<in> set nodes'"
       have h1: "(\<And>children child nodes node nodes'.
              h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow>
              child \<in> set children \<Longrightarrow> h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes
              \<longrightarrow> (node \<in> set nodes \<longrightarrow> (h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<longrightarrow> set nodes' \<subseteq> set nodes)))"
         using 1
         by blast
       obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
         using 2
         by(auto simp add: to_tree_order_def elim!: bind_returns_result_E)
       then have "set nodes' \<subseteq> set nodes"
       proof (cases "children = []")
         case True
         then show ?thesis
           by (metis "2" "3" \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> children empty_iff list.set(1)
               subsetI to_tree_order_either_ptr_or_in_children)
       next
         case False
         then show ?thesis
         proof (cases "node = parent")
           case True
           then show ?thesis
             using "2" \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> returns_result_eq by fastforce
         next
           case False
           then obtain child nodes_of_child where
             "child \<in> set children" and
             "h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes_of_child" and
             "node \<in> set nodes_of_child"
             using 2[simplified to_tree_order_def] 3
               to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children
             apply(auto elim!: bind_returns_result_E2 intro: map_M_pure_I)[1]
             using is_OK_returns_result_E 2 a_all_ptrs_in_heap_def assms(1) heap_is_wellformed_def
             using "3" by blast
           then have "set nodes' \<subseteq> set nodes_of_child"
             using h1
             using \<open>h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes'\<close> children by blast
           moreover have "set nodes_of_child \<subseteq> set nodes"
             using "2" \<open>child \<in> set children\<close> \<open>h \<turnstile> to_tree_order (cast child) \<rightarrow>\<^sub>r nodes_of_child\<close>
               assms children to_tree_order_child_subset by auto
           ultimately show ?thesis
             by blast
         qed
       qed
       then show "x \<in> set nodes"
         using \<open>x \<in> set nodes'\<close> by blast
     qed
   qed
   then show ?thesis
     using assms by blast
 qed
 
 lemma to_tree_order_parent:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent"
   assumes "parent \<in> set nodes"
   shows "cast child \<in> set nodes"
 proof -
   obtain nodes' where nodes': "h \<turnstile> to_tree_order parent \<rightarrow>\<^sub>r nodes'"
     using assms to_tree_order_ok get_parent_parent_in_heap
     by (meson get_parent_parent_in_heap is_OK_returns_result_E)
 
   then have "set nodes' \<subseteq> set nodes"
     using to_tree_order_subset assms
     by blast
   moreover obtain children where
     children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children" and
     child: "child \<in> set children"
     using assms get_parent_child_dual by blast
   then obtain child_to where child_to: "h \<turnstile> to_tree_order (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 child_to"
     by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I
         get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok)
   then have "cast child \<in> set child_to"
     apply(simp add: to_tree_order_def)
     by(auto elim!: bind_returns_result_E2 map_M_pure_E
         dest!: bind_returns_result_E3[rotated, OF children, rotated]  intro!: map_M_pure_I)
 
   have "cast child \<in> set nodes'"
     using nodes' child
     apply(simp add: to_tree_order_def)
     apply(auto elim!: bind_returns_result_E2 map_M_pure_E
         dest!: bind_returns_result_E3[rotated, OF children, rotated]  intro!: map_M_pure_I)[1]
     using child_to \<open>cast child \<in> set child_to\<close> returns_result_eq by fastforce
   ultimately show ?thesis
     by auto
 qed
 
 lemma to_tree_order_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
   assumes "cast child \<noteq> ptr"
   assumes "child \<in> set children"
   assumes "cast child \<in> set nodes"
   shows "parent \<in> set nodes"
 proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes
     rule: heap_wellformed_induct)
   case (step p)
   have "p |\<in>| object_ptr_kinds h"
     using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
     using assms(1) assms(2) assms(3) by blast
   then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then show ?thesis
       using step(2) step(3) step(4) children
       by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])
   next
     case False
     then obtain c child_to where
       child: "c \<in> set children" and
       child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
       "cast child \<in> set child_to"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
       by (metis (full_types) assms(1) assms(2) assms(3) get_parent_ptr_in_heap
           is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual
           l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes
           returns_result_select_result step.prems(1) step.prems(2) step.prems(3)
           to_tree_order_either_ptr_or_in_children to_tree_order_ok)
     then have "set child_to \<subseteq> set nodes"
       using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
     show ?thesis
     proof (cases "c = child")
       case True
       then have "parent = p"
         using step(3) children child assms(5) assms(7)
         by (meson assms(1) assms(2) assms(3) child_parent_dual option.inject returns_result_eq)
 
       then show ?thesis
         using step.prems(1) to_tree_order_ptr_in_result by blast
     next
       case False
       then show ?thesis
         using step(1)[OF children child child_to] step(3) step(4)
         using \<open>set child_to \<subseteq> set nodes\<close>
         using \<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 child \<in> set child_to\<close> by auto
     qed
   qed
 qed
 
 lemma to_tree_order_node_ptrs:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "ptr' \<noteq> ptr"
   assumes "ptr' \<in> set nodes"
   shows "is_node_ptr_kind ptr'"
 proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes
     rule: heap_wellformed_induct)
   case (step p)
   have "p |\<in>| object_ptr_kinds h"
     using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
     using assms(1) assms(2) assms(3) by blast
   then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
     by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
   then show ?case
   proof (cases "children = []")
     case True
     then show ?thesis
       using step(2) step(3) step(4) children
       by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
   next
     case False
     then obtain c child_to where
       child: "c \<in> set children" and
       child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
       "ptr' \<in> set child_to"
       using step(2) children
       apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
           dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
       using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast
     then have "set child_to \<subseteq> set nodes"
       using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
     show ?thesis
     proof (cases "cast c = ptr")
       case True
       then show ?thesis
         using step \<open>ptr' \<in> set child_to\<close> assms(5) child child_to children by blast
     next
       case False
       then show ?thesis
         using \<open>ptr' \<in> set child_to\<close> child child_to children is_node_ptr_kind_cast step.hyps by blast
     qed
   qed
 qed
 
 lemma to_tree_order_child2:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes"
   assumes "cast child \<noteq> ptr"
   assumes "cast child \<in> set nodes"
   obtains parent where "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent" and "parent \<in> set nodes"
 proof -
   assume 1: "(\<And>parent. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent \<Longrightarrow> parent \<in> set nodes \<Longrightarrow> thesis)"
   show thesis
   proof(insert assms(1) assms(4) assms(5) assms(6) 1, induct ptr arbitrary: nodes
       rule: heap_wellformed_induct)
     case (step p)
     have "p |\<in>| object_ptr_kinds h"
       using \<open>h \<turnstile> to_tree_order p \<rightarrow>\<^sub>r nodes\<close> to_tree_order_ptr_in_heap
       using assms(1) assms(2) assms(3) by blast
     then obtain children where children: "h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children"
       by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr)
     then show ?case
     proof (cases "children = []")
       case True
       then show ?thesis
         using step(2) step(3) step(4) children
         by(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
             dest!: bind_returns_result_E3[rotated, OF children, rotated])
     next
       case False
       then obtain c child_to where
         child: "c \<in> set children" and
         child_to: "h \<turnstile> to_tree_order (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 c) \<rightarrow>\<^sub>r child_to" and
         "cast child \<in> set child_to"
         using step(2) children
         apply(auto simp add: to_tree_order_def[of p] map_M_pure_I  elim!: bind_returns_result_E2
             dest!: bind_returns_result_E3[rotated, OF children, rotated])[1]
         using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children
         by blast
       then have "set child_to \<subseteq> set nodes"
         using assms(1) child children step.prems(1) to_tree_order_child_subset by auto
 
       have "cast child |\<in>| object_ptr_kinds h"
         using assms(1) assms(2) assms(3) assms(4) assms(6) to_tree_order_ptrs_in_heap by blast
       then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r parent_opt"
         by (meson assms(2) assms(3) is_OK_returns_result_E get_parent_ok node_ptr_kinds_commutes)
       then show ?thesis
       proof (induct parent_opt)
         case None
         then show ?case
           by (metis \<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 child \<in> set child_to\<close> assms(1) assms(2) assms(3)
               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_inject child child_parent_dual child_to children
               option.distinct(1) returns_result_eq step.hyps)
       next
         case (Some option)
         then show ?case
           by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2)
               step.prems(3) step.prems(4) to_tree_order_child)
       qed
     qed
   qed
 qed
 
 lemma to_tree_order_parent_child_rel:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   shows "(ptr, child) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> child \<in> set to"
 proof
   assume 3: "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   show "child \<in> set to"
   proof (insert 3, induct child rule: heap_wellformed_induct_rev[OF assms(1)])
     case (1 child)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         using assms(4)
         apply(simp add: to_tree_order_def)
         by(auto simp add: map_M_pure_I elim!: bind_returns_result_E2)
     next
       case False
       obtain child_parent where
         "(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*" and
         "(child_parent, child) \<in> (parent_child_rel h)"
         using \<open>ptr \<noteq> child\<close>
         by (metis "1.prems" rtranclE)
       obtain child_node where child_node: "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 = child"
         using \<open>(child_parent, child) \<in> parent_child_rel h\<close> node_ptr_casts_commute3
           parent_child_rel_node_ptr
         by blast
       then have "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some child_parent"
         using \<open>(child_parent, child) \<in> (parent_child_rel h)\<close>
         by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual
             l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok
             local.known_ptrs_known_ptr local.l_get_parent_wf_axioms
             local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap)
       then show ?thesis
         using 1(1) child_node \<open>(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*\<close>
         using assms(1) assms(2) assms(3) assms(4) to_tree_order_parent by blast
     qed
   qed
 next
   assume "child \<in> set to"
   then show "(ptr, child) \<in> (parent_child_rel h)\<^sup>*"
   proof (induct child rule: heap_wellformed_induct_rev[OF assms(1)])
     case (1 child)
     then show ?case
     proof (cases "ptr = child")
       case True
       then show ?thesis
         by simp
     next
       case False
       then have "\<exists>parent. (parent, child) \<in> (parent_child_rel h)"
         using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)]
           to_tree_order_node_ptrs
         by (metis assms(1) assms(2) assms(3) node_ptr_casts_commute3 parent_child_rel_parent)
       then obtain child_node where child_node: "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 = child"
         using node_ptr_casts_commute3 parent_child_rel_node_ptr by blast
       then obtain child_parent where child_parent: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some child_parent"
         using \<open>\<exists>parent. (parent, child) \<in> (parent_child_rel h)\<close>
         by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) to_tree_order_child2)
       then have "(child_parent, child) \<in> (parent_child_rel h)"
         using assms(1) child_node parent_child_rel_parent by blast
       moreover have "child_parent \<in> set to"
         by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent
             get_parent_child_dual to_tree_order_child)
       then have "(ptr, child_parent) \<in> (parent_child_rel h)\<^sup>*"
         using 1 child_node child_parent by blast
       ultimately show ?thesis
         by auto
     qed
   qed
 qed
 end
 
 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
   using instances
   apply(simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
   done
 declare l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_to_tree_order_defs
   + l_get_parent_defs + l_get_child_nodes_defs +
   assumes to_tree_order_ok:
     "heap_is_wellformed h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
                           \<Longrightarrow> h \<turnstile> ok (to_tree_order ptr)"
   assumes to_tree_order_ptrs_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> ptr' \<in> set to \<Longrightarrow> ptr' |\<in>| object_ptr_kinds h"
   assumes to_tree_order_parent_child_rel:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> (ptr, child_ptr) \<in> (parent_child_rel h)\<^sup>* \<longleftrightarrow> child_ptr \<in> set to"
   assumes to_tree_order_child2:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> cast child \<noteq> ptr \<Longrightarrow> cast child \<in> set nodes
                           \<Longrightarrow> (\<And>parent. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent
                                          \<Longrightarrow> parent \<in> set nodes \<Longrightarrow> thesis)
                           \<Longrightarrow> thesis"
   assumes to_tree_order_node_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> ptr' \<noteq> ptr \<Longrightarrow> ptr' \<in> set nodes \<Longrightarrow> is_node_ptr_kind ptr'"
   assumes to_tree_order_child:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow> cast child \<noteq> ptr
                           \<Longrightarrow> child \<in> set children \<Longrightarrow> cast child \<in> set nodes
                           \<Longrightarrow> parent \<in> set nodes"
   assumes to_tree_order_ptr_in_result:
     "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<Longrightarrow> ptr \<in> set nodes"
   assumes to_tree_order_parent:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes
                           \<Longrightarrow> h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent \<Longrightarrow> parent \<in> set nodes
                           \<Longrightarrow> cast child \<in> set nodes"
   assumes to_tree_order_subset:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r nodes \<Longrightarrow> node \<in> set nodes
                           \<Longrightarrow> h \<turnstile> to_tree_order node \<rightarrow>\<^sub>r nodes' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> set nodes' \<subseteq> set nodes"
 
 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"
   using instances
   apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def)[1]
   using to_tree_order_ok
            apply blast
   using to_tree_order_ptrs_in_heap
           apply blast
   using to_tree_order_parent_child_rel
          apply(blast, blast)
   using to_tree_order_child2
        apply blast
   using to_tree_order_node_ptrs
       apply blast
   using to_tree_order_child
      apply blast
   using to_tree_order_ptr_in_result
     apply blast
   using to_tree_order_parent
    apply blast
   using to_tree_order_subset
   apply blast
   done
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 locale l_to_tree_order_wf_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
   + l_to_tree_order_wf
 begin
 lemma to_tree_order_get_root_node:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   assumes "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
   assumes "ptr'' \<in> set to"
   shows "h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
 proof -
   obtain ancestors' where ancestors': "h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'"
     by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E
         to_tree_order_ptrs_in_heap )
   moreover have "ptr \<in> set ancestors'"
     using \<open>h \<turnstile> get_ancestors ptr' \<rightarrow>\<^sub>r ancestors'\<close>
     using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel
       to_tree_order_parent_child_rel by blast
 
   ultimately have "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr"
     using \<open>h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr\<close>
     using assms(1) assms(2) assms(3) get_ancestors_ptr get_ancestors_same_root_node by blast
 
   obtain ancestors'' where ancestors'': "h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''"
     by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E
         to_tree_order_ptrs_in_heap)
   moreover have "ptr \<in> set ancestors''"
     using \<open>h \<turnstile> get_ancestors ptr'' \<rightarrow>\<^sub>r ancestors''\<close>
     using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel
       to_tree_order_parent_child_rel by blast
   ultimately show ?thesis
     using \<open>h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr\<close> assms(1) assms(2) assms(3) get_ancestors_ptr
       get_ancestors_same_root_node by blast
 qed
 
 lemma to_tree_order_same_root:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr"
   assumes "h \<turnstile> to_tree_order root_ptr \<rightarrow>\<^sub>r to"
   assumes "ptr' \<in> set to"
   shows "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
 proof (insert assms(1)(*  assms(4) assms(5) *) assms(6), induct ptr' rule: heap_wellformed_induct_rev)
   case (step child)
   then show ?case
   proof (cases "h \<turnstile> get_root_node child \<rightarrow>\<^sub>r child")
     case True
     then have "child = root_ptr"
       using  assms(1) assms(2) assms(3) assms(5) step.prems
       by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3
           option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs)
     then show ?thesis
       using True by blast
   next
     case False
     then obtain child_node parent where "cast child_node = child"
       and "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent"
       by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent
           local.get_root_node_not_node_same local.get_root_node_same_no_parent
           local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3
           step.prems)
     then show ?thesis
     proof (cases "child = root_ptr")
       case True
       then have "h \<turnstile> get_root_node root_ptr \<rightarrow>\<^sub>r root_ptr"
         using assms(4)
         using \<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 child_node = child\<close> assms(1) assms(2) assms(3)
           get_root_node_no_parent get_root_node_same_no_parent
         by blast
       then show ?thesis
         using step assms(4)
         using True by blast
     next
       case False
       then have "parent \<in> set to"
         using assms(5) step(2) to_tree_order_child \<open>h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent\<close>
           \<open>cast child_node = child\<close>
         by (metis False assms(1) assms(2) assms(3) get_parent_child_dual)
       then show ?thesis
         using \<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 child_node = child\<close> \<open>h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent\<close>
           get_root_node_parent_same
         using step.hyps by blast
     qed
 
   qed
 qed
 end
 
 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
   using instances
   by(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)
 
 locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs
   + l_get_root_node_defs + l_heap_is_wellformed_defs +
   assumes to_tree_order_get_root_node:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to
                           \<Longrightarrow> ptr' \<in> set to \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr
                           \<Longrightarrow> ptr'' \<in> set to \<Longrightarrow> h \<turnstile> get_root_node ptr'' \<rightarrow>\<^sub>r root_ptr"
   assumes to_tree_order_same_root:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr
                           \<Longrightarrow> h \<turnstile> to_tree_order root_ptr \<rightarrow>\<^sub>r to \<Longrightarrow> ptr' \<in> set to
                           \<Longrightarrow> h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root_ptr"
 
 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 type_wf known_ptr known_ptrs to_tree_order
                                        get_root_node heap_is_wellformed"
   using instances
   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)[1]
   using to_tree_order_get_root_node apply blast
   using to_tree_order_same_root apply blast
   done
 
 
 subsection \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_known_ptrs
   + l_heap_is_wellformed
   + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_get_ancestors
   + l_get_ancestors_wf
   + l_get_parent
   + l_get_parent_wf
   + l_get_root_node_wf
   + l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 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 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
   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 (metis (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3)
         disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent
         local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms
         returns_result_select_result select_result_I2 type_wf)
 
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     using heap_is_wellformed_children_disc_nodes_different child_parent_dual assms
     using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok
       returns_result_select_result split_option_ex
     by (metis (no_types, lifting))
 
   then have 4: "h \<turnstile> get_root_node (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using 2 get_root_node_no_parent
     by blast
   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 unfolding heap_is_wellformed_def
     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 eq: "\<And>document_ptr. document_ptr |\<in>| document_ptr_kinds h
            \<Longrightarrow> node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r \<longleftrightarrow> |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"
     apply(auto dest!: get_disconnected_nodes_ok[OF type_wf]
         intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1]
     apply(drule select_result_E[where P=id, simplified])
     by(auto elim!: bind_returns_result_E2)
 
   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]
     using eq
     using local.get_disconnected_nodes_ok apply auto[1]
     using assms(2) assms(3)
       apply(auto intro!: intro!: select_result_I[where P=id, simplified]
         elim!: bind_returns_result_E2)[1]
     using returns_result_eq apply fastforce
     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
     unfolding heap_is_wellformed_def
     by(auto intro: bind_pure_I bind_is_OK_I2)
 
   with 4 document_ptrs have "h \<turnstile> 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: 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)[1]
   moreover have "known_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)"
     using "4" assms(1)  known_ptrs type_wf known_ptrs_known_ptr "2" node_ptr_kinds_commutes by blast
   ultimately show ?thesis
     using 2
     apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, (rule conjI | rule impI)+)+
        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 split: option.splits intro!: bind_pure_returns_result_I)
 qed
 
 lemma in_disconnected_nodes_no_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     and "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document"
     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 -
   have 2: "cast node_ptr |\<in>| object_ptr_kinds h"
     using assms(3) get_owner_document_ptr_in_heap by fast
   then have 3: "h \<turnstile> get_root_node (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using assms(2) local.get_root_node_no_parent by blast
 
   have "\<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)"
     apply(auto)[1]
     using assms(2) child_parent_dual[OF assms(1)] type_wf
       assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3)
       returns_result_eq returns_result_select_result
     by (metis (no_types, opaque_lifting))
   moreover have "node_ptr |\<in>| node_ptr_kinds h"
     using assms(2) get_parent_ptr_in_heap by blast
   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 (metis DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) finite_set_in heap_is_wellformed_children_disc_nodes)
   then  obtain document_ptr where
     document_ptr: "document_ptr\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r" and
     node_ptr_in_disc_nodes: "node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     by auto
   then show ?thesis
     using get_owner_document_disconnected_nodes known_ptrs type_wf assms
     using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok
       returns_result_select_result select_result_I2
     by (metis (no_types, opaque_lifting) )
 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)[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>_. (local.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: 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>_. (local.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 obtain root where
     root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     by(auto simp add: 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 4 5 root
       apply(auto simp add: 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 "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast
   next
     case False
     have "known_ptr root"
       using "0" "1" "2" 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 "0" "1" "2" local.get_root_node_root_in_heap
       by blast
     then have "is_node_ptr_kind root"
       using False \<open>known_ptr root\<close>
       apply(simp add: known_ptr_impl 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)"
       by (metis (no_types, lifting) "0" "1" "2" \<open>root |\<in>| object_ptr_kinds h\<close> 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
           notin_fset option.distinct(1) returns_result_eq returns_result_select_result root)
     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) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
           is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset
           return_ok return_pure sorted_list_of_set(1))
     then have "some_owner_document \<in> set candidates"
       apply(rule filter_M_in_result_if_ok)
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
        apply (simp add: \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>)
       using "1" \<open>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 |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         local.get_disconnected_nodes_ok by auto
     then have "candidates \<noteq> []"
       by auto
     then have "owner_document \<in> set candidates"
       using 5 root 4
       apply(auto simp add: 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
 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>_. (local.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 obtain root where
     root: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root"
     by(auto simp add: 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 3 4 root
       apply(auto simp add: 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 "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast
   next
     case False
     have "known_ptr root"
       using "0" "1" "2" 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 "0" "1" "2" local.get_root_node_root_in_heap
       by blast
     then have "is_node_ptr_kind root"
       using False \<open>known_ptr root\<close>
       apply(simp add: known_ptr_impl 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)"
       by (metis (no_types, lifting) "0" "1" "2" \<open>root |\<in>| object_ptr_kinds h\<close>
           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 notin_fset option.distinct(1) returns_result_eq
           returns_result_select_result root)
     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) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
           is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset
           return_ok return_pure sorted_list_of_set(1))
     then have "some_owner_document \<in> set candidates"
       apply(rule filter_M_in_result_if_ok)
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
        apply (simp add: \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>)
       using "1" \<open>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 |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         \<open>some_owner_document |\<in>| document_ptr_kinds h\<close> local.get_disconnected_nodes_ok
       by auto
 
     then have "candidates \<noteq> []"
       by auto
     then have "owner_document \<in> set candidates"
       using 4 root 3
       apply(auto simp add: 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_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)[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_element_ptr
        apply blast
     using assms(4)
       apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
       apply (metis (no_types, lifting) document_ptr_casts_commute3 document_ptr_kinds_commutes
         is_document_ptr_kind_none option.case_eq_if)
     using assms(4)
      apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
       apply (metis (no_types, lifting) assms(1) assms(2) assms(3) is_node_ptr_kind_none
         local.get_root_node_ok node_ptr_casts_commute3 option.case_eq_if)
     using assms(4)
      apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
      apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I
         filter_M_is_OK_I)[1]
     using assms(3) local.get_disconnected_nodes_ok
      apply blast
     apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok)
     using assms(4)
     apply(auto simp add: 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_is_OK_pure_I)[1]
      apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I
         filter_M_is_OK_I)[1]
      apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok)[1]
     apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I
         filter_M_is_OK_I)[1]
     using assms(3) local.get_disconnected_nodes_ok by blast
 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
 
   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> 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> 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> 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:  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>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 known_ptr_impl)[1]
        apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
           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>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 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>
       by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs
           ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)
     then have "h \<turnstile> 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> 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 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 known_ptr_impl)[1]
        apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
           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
          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
         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
        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
       apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
       apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
          apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
          apply (meson invoke_empty is_OK_returns_result_I)
         apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
        apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
       by(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1]
   qed
   then show ?thesis
     using \<open>known_ptr (cast child)\<close>
     apply(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 known_ptr_impl)[1]
      apply(split invoke_splits, ((rule conjI | rule impI)+)?)+
         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>
        apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
       apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
      apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     using \<open>cast child |\<in>| object_ptr_kinds h\<close> \<open>ptr |\<in>| object_ptr_kinds h\<close>
     apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1]
     by (smt \<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 child |\<in>| object_ptr_kinds h\<close> cast_document_ptr_not_node_ptr(1)
         comp_apply invoke_empty invoke_not invoke_returns_result is_OK_returns_result_I
         node_ptr_casts_commute2 option.sel)
 qed
 
 end
 
 locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_get_disconnected_nodes_defs + l_get_owner_document_defs
   + l_get_parent_defs + l_get_child_nodes_defs +
   assumes get_owner_document_disconnected_nodes:
     "heap_is_wellformed h \<Longrightarrow>
      known_ptrs h \<Longrightarrow>
      type_wf h \<Longrightarrow>
      h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
      node_ptr \<in> set disc_nodes \<Longrightarrow>
      h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r document_ptr"
   assumes in_disconnected_nodes_no_parent:
     "heap_is_wellformed h \<Longrightarrow>
     h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None\<Longrightarrow>
     h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document \<Longrightarrow>
     h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
     known_ptrs h \<Longrightarrow>
     type_wf h\<Longrightarrow>
     node_ptr \<in> set disc_nodes"
   assumes get_owner_document_owner_document_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow>
 h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<Longrightarrow>
 owner_document |\<in>| document_ptr_kinds h"
   assumes get_owner_document_ok:
     "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h
                           \<Longrightarrow> h \<turnstile> ok (get_owner_document ptr)"
   assumes get_owner_document_child_same:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow>
 child \<in> set children \<Longrightarrow> h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow>
 h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r owner_document"
 
 interpretation i_get_owner_document_wf?: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr known_ptrs type_wf 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 get_owner_document
   by(auto simp add: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def)[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
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 locale l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf
 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)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
          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: 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_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)[1]
       apply(split invoke_splits, (rule conjI | rule impI)+)+
          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: 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)[2]
   }
   ultimately
   show ?thesis
     using \<open>known_ptr ptr\<close>
     by(auto simp add: known_ptr_impl 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 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> local.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)[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
         have "is_document_ptr root"
           using True \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl 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)[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>
           by(auto simp add: 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)
 
       next
         case False
         then have "is_node_ptr_kind root"
           using \<open>known_ptr root\<close>
           by(auto simp add: known_ptr_impl 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> local.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> local.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: 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)[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 DocumentClass.known_ptr_defs
               CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs
               split: option.splits)[1]
             apply(auto simp add: known_ptr_impl 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)[1]
           apply(split invoke_splits)+
              apply (meson invoke_empty is_OK_returns_result_I)
             apply(auto simp add: True 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)[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 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> local.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)[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> local.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: 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)[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 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 get_owner_document_wf_get_root_node_wf?: l_get_owner_document_wf_get_root_node_wf\<^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 heap_is_wellformed
   parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs get_owner_document
   by(auto simp add: l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_owner_document_wf_get_root_node_wf = l_heap_is_wellformed_defs + l_type_wf +
   l_known_ptrs + l_get_root_node_defs + l_get_owner_document_defs +
   assumes get_root_node_document:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow>
 is_document_ptr_kind root \<Longrightarrow> h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r the (cast root)"
   assumes get_root_node_same_owner_document:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root \<Longrightarrow>
 h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<longleftrightarrow> h \<turnstile> get_owner_document root \<rightarrow>\<^sub>r owner_document"
 
 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
 
 
 subsection \<open>Preserving heap-wellformedness\<close>
 
 subsection \<open>set\_attribute\<close>
 
 locale l_set_attribute_wf\<^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 +
   l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_attribute_get_disconnected_nodes +
   l_set_attribute_get_child_nodes
 begin
 lemma set_attribute_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> set_attribute element_ptr k v \<rightarrow>\<^sub>h h'"
   shows "heap_is_wellformed h'"
   thm preserves_wellformedness_writes_needed
   apply(rule preserves_wellformedness_writes_needed[OF assms set_attribute_writes])
   using  set_attribute_get_child_nodes
     apply(fast)
   using set_attribute_get_disconnected_nodes apply(fast)
   by(auto simp add: all_args_def set_attribute_locs_def)
 end
 
 
 subsection \<open>remove\_child\<close>
 
 locale l_remove_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed +
   l_set_disconnected_nodes_get_child_nodes
 begin
 lemma remove_child_removes_parent:
   assumes wellformed: "heap_is_wellformed h"
     and remove_child: "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h2"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "h2 \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
 proof -
   obtain children where children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     using remove_child remove_child_def by auto
   then have "child \<in> set children"
     using remove_child remove_child_def
     by(auto elim!: bind_returns_heap_E dest: returns_result_eq split: if_splits)
   then have h1: "\<And>other_ptr other_children. other_ptr \<noteq> ptr
                 \<Longrightarrow> h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
     using assms(1) known_ptrs  type_wf child_parent_dual
     by (meson child_parent_dual children option.inject returns_result_eq)
 
   have known_ptr: "known_ptr ptr"
     using known_ptrs
     by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms
         remove_child remove_child_ptr_in_heap)
 
   obtain owner_document disc_nodes h' where
     owner_document: "h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r owner_document" and
     disc_nodes: "h \<turnstile>  get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h': "h \<turnstile>  set_disconnected_nodes owner_document (child # disc_nodes) \<rightarrow>\<^sub>h h'" and
     h2: "h' \<turnstile> set_child_nodes ptr (remove1 child children) \<rightarrow>\<^sub>h h2"
     using assms children unfolding remove_child_def
     apply(auto split: if_splits elim!: bind_returns_heap_E)[1]
     by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure
         get_owner_document_pure pure_returns_heap_eq returns_result_eq)
 
   have "object_ptr_kinds h = object_ptr_kinds h2"
     using remove_child_writes remove_child unfolding remove_child_locs_def
     apply(rule writes_small_big)
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by(auto simp add: reflp_def transp_def)
   then have "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
     unfolding object_ptr_kinds_M_defs by simp
 
   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 type_wf
     by(auto simp add: reflp_def transp_def)
   have "type_wf h2"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'",
         OF remove_child_writes remove_child]  unfolding remove_child_locs_def
     using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf
     apply(auto simp add: reflp_def transp_def)[1]
     by blast
   then obtain children' where children': "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'"
     using h2 set_child_nodes_get_child_nodes known_ptr
     by (metis \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> children get_child_nodes_ok
         get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I)
 
   have "child \<notin> set children'"
     by (metis (mono_tags, lifting) \<open>type_wf h'\<close> children children' distinct_remove1_removeAll h2
         known_ptr local.heap_is_wellformed_children_distinct
         local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2
         wellformed)
 
 
   moreover have "\<And>other_ptr other_children. other_ptr \<noteq> ptr
                 \<Longrightarrow> h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
   proof -
     fix other_ptr other_children
     assume a1: "other_ptr \<noteq> ptr"  and a3: "h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
     have "h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
       using get_child_nodes_reads set_disconnected_nodes_writes h' a3
       apply(rule reads_writes_separate_backwards)
       using set_disconnected_nodes_get_child_nodes by fast
     show "child \<notin> set other_children"
       using \<open>h \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children\<close> a1 h1 by blast
   qed
   then have "\<And>other_ptr other_children. other_ptr \<noteq> ptr
             \<Longrightarrow>  h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children \<Longrightarrow> child \<notin> set other_children"
   proof -
     fix other_ptr other_children
     assume a1: "other_ptr \<noteq> ptr" and a3: "h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
     have "h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children"
       using get_child_nodes_reads set_child_nodes_writes h2 a3
       apply(rule reads_writes_separate_backwards)
       using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers
       by metis
     then show "child \<notin> set other_children"
       using \<open>\<And>other_ptr other_children. \<lbrakk>other_ptr \<noteq> ptr; h' \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children\<rbrakk>
              \<Longrightarrow> child \<notin> set other_children\<close> a1 by blast
   qed
   ultimately have ha: "\<And>other_ptr other_children. h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children
                       \<Longrightarrow> child \<notin> set other_children"
     by (metis (full_types) children' returns_result_eq)
   moreover obtain ptrs where ptrs: "h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by (simp add: object_ptr_kinds_M_defs)
   moreover have "\<And>ptr. ptr \<in> set ptrs \<Longrightarrow> h2 \<turnstile> ok (get_child_nodes ptr)"
     using \<open>type_wf h2\<close> ptrs get_child_nodes_ok known_ptr
     using \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> known_ptrs local.known_ptrs_known_ptr by auto
   ultimately show "h2 \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
     apply(auto simp add: get_parent_def intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I)[1]
   proof -
     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 child |\<in>| object_ptr_kinds h"
       using get_owner_document_ptr_in_heap owner_document by blast
     then show "h2 \<turnstile> check_in_heap (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 ()"
       by (simp add: \<open>object_ptr_kinds h = object_ptr_kinds h2\<close> check_in_heap_def)
   next
     show "(\<And>other_ptr other_children. h2 \<turnstile> get_child_nodes other_ptr \<rightarrow>\<^sub>r other_children
          \<Longrightarrow> child \<notin> set other_children) \<Longrightarrow>
     ptrs = sorted_list_of_set (fset (object_ptr_kinds h2)) \<Longrightarrow>
     (\<And>ptr. ptr |\<in>| object_ptr_kinds h2 \<Longrightarrow> h2 \<turnstile> ok get_child_nodes ptr) \<Longrightarrow>
     h2 \<turnstile> filter_M (\<lambda>ptr. Heap_Error_Monad.bind (get_child_nodes ptr)
        (\<lambda>children. return (child \<in> set children))) (sorted_list_of_set (fset (object_ptr_kinds h2))) \<rightarrow>\<^sub>r []"
       by(auto intro!: filter_M_empty_I bind_pure_I)
   qed
 qed
 end
 
 locale l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_remove_child_wf\<^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
 begin
 
 lemma remove_child_parent_child_rel_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "parent_child_rel h' \<subseteq> parent_child_rel h"
 proof (standard, safe)
 
   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(2)
     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 object_ptr_kinds_eq3: "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(2)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_eq: "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     using node_ptr_kinds_M_eq by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     using document_ptr_kinds_M_eq by auto
   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(2)])
     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 disconnected_nodes_eq:
     "\<And>document_ptr disconnected_nodes. document_ptr \<noteq> owner_document
        \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
          = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)])
     unfolding remove_child_locs_def
     using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers
     by (metis (no_types, lifting) Un_iff owner_document select_result_I2)
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. document_ptr \<noteq> owner_document
        \<Longrightarrow> |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes document_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 "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 type_wf
     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_child_nodes_writes h']
     using  set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r remove1 child children_h"
     using assms(2) 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
 
   fix parent child
   assume a1: "(parent, child) \<in> parent_child_rel h'"
   then show "(parent, child) \<in> parent_child_rel h"
   proof (cases "parent = ptr")
     case True
     then show ?thesis
       using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h'
         get_child_nodes_ptr_in_heap
       apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1]
       by (metis notin_set_remove1)
   next
     case False
     then show ?thesis
       using a1
       by(auto simp add: parent_child_rel_def object_ptr_kinds_eq3 children_eq2)
   qed
 qed
 
 
 lemma remove_child_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "type_wf h'" and "known_ptrs h'" and "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(2)
     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 object_ptr_kinds_eq3: "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(2)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_eq: "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     using node_ptr_kinds_M_eq by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     using document_ptr_kinds_M_eq by auto
   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(2)])
     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 disconnected_nodes_eq: "\<And>document_ptr disconnected_nodes. document_ptr \<noteq> owner_document
          \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
              = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)])
     unfolding remove_child_locs_def
     using set_child_nodes_get_disconnected_nodes
       set_disconnected_nodes_get_disconnected_nodes_different_pointers
     by (metis (no_types, lifting) Un_iff owner_document select_result_I2)
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. document_ptr \<noteq> owner_document
     \<Longrightarrow> |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes document_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)
 
   show "known_ptrs h'"
     using object_ptr_kinds_eq3 known_ptrs_preserved \<open>known_ptrs h\<close> by blast
 
   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 type_wf
     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_child_nodes_writes h']
     using  set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r remove1 child children_h"
     using assms(2) 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_h2:
     "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     using owner_document assms(2) h2 disconnected_nodes_h
     apply (auto simp add: remove_child_def  split: if_splits)[1]
     apply(drule bind_returns_heap_E2)
       apply(auto split: if_splits)[1]
      apply(simp)
     by(auto simp add: local.set_disconnected_nodes_get_disconnected_nodes split: if_splits)
   then have disconnected_nodes_h':
     "h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     apply(rule reads_writes_separate_forwards[OF get_disconnected_nodes_reads set_child_nodes_writes h'])
     by (simp add: set_child_nodes_get_disconnected_nodes)
 
   moreover have "a_acyclic_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
   proof (standard, safe)
     fix parent child
     assume a1: "(parent, child) \<in> parent_child_rel h'"
     then show "(parent, child) \<in> parent_child_rel h"
     proof (cases "parent = ptr")
       case True
       then show ?thesis
         using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h'
           get_child_nodes_ptr_in_heap
         apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1]
         by (metis imageI notin_set_remove1)
     next
       case False
       then show ?thesis
         using a1
         by(auto simp add: parent_child_rel_def object_ptr_kinds_eq3 children_eq2)
     qed
   qed
   then have "a_acyclic_heap h'"
     using \<open>a_acyclic_heap h\<close> acyclic_heap_def acyclic_subset by blast
 
   moreover have "a_all_ptrs_in_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3 disconnected_nodes_eq)[1]
      apply (metis (no_types, lifting) \<open>type_wf h'\<close> assms(2) assms(3) local.get_child_nodes_ok
         local.known_ptrs_known_ptr local.remove_child_children_subset notin_fset object_ptr_kinds_eq3
         returns_result_select_result subset_code(1) type_wf)
     apply (metis (no_types, lifting) assms(2) disconnected_nodes_eq2 disconnected_nodes_h
         disconnected_nodes_h' document_ptr_kinds_eq3 finite_set_in local.remove_child_child_in_heap
         node_ptr_kinds_eq3 select_result_I2 set_ConsD subset_code(1))
     done
   moreover have "a_owner_document_valid h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3
         node_ptr_kinds_eq3)[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 h' \<and> node_ptr \<in> set |h \<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 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"
     proof (cases "node_ptr = child")
       case True
       show ?thesis
         apply(rule exI[where x=owner_document])
         using children_eq2 disconnected_nodes_eq2 children_h children_h' disconnected_nodes_h' True
         by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I
             list.set_intros(1) select_result_I2)
     next
       case False
       then show ?thesis
         using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h
           disconnected_nodes_h'
         apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1]
         by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2))
     qed
   qed
 
   moreover
   {
     have h0: "a_distinct_lists h"
       using assms(1)  by (simp add: heap_is_wellformed_def)
     moreover have ha1: "(\<Union>x\<in>set |h \<turnstile> object_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_child_nodes x|\<^sub>r)
                  \<inter> (\<Union>x\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       using \<open>a_distinct_lists h\<close>
       unfolding a_distinct_lists_def
       by(auto)
     have ha2: "ptr |\<in>| object_ptr_kinds h"
       using children_h get_child_nodes_ptr_in_heap by blast
     have ha3: "child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r"
       using child_in_children_h children_h
       by(simp)
     have child_not_in: "\<And>document_ptr. document_ptr |\<in>| document_ptr_kinds h
                           \<Longrightarrow> child \<notin> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
       using ha1 ha2 ha3
       apply(simp)
       using IntI by fastforce
     moreover have "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: object_ptr_kinds_M_defs)
     moreover have "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: document_ptr_kinds_M_defs)
     ultimately have "a_distinct_lists h'"
     proof(simp (no_asm) add: a_distinct_lists_def, safe)
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
 
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       have 4: "distinct (concat ((map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)))"
         using 1 by(auto simp add: a_distinct_lists_def)
       show "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                      (sorted_list_of_set (fset (object_ptr_kinds h')))))"
       proof(rule distinct_concat_map_I[OF 3[unfolded object_ptr_kinds_eq2], simplified])
         fix x
         assume 5: "x |\<in>| object_ptr_kinds h'"
         then have 6: "distinct |h \<turnstile> get_child_nodes x|\<^sub>r"
           using 4 distinct_concat_map_E object_ptr_kinds_eq2 by fastforce
         obtain children where children: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children"
           and distinct_children: "distinct children"
           by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr
               object_ptr_kinds_eq3 select_result_I)
         obtain children' where children': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children'"
           using children children_eq children_h' by fastforce
         then have "distinct children'"
         proof (cases "ptr = x")
           case True
           then show ?thesis
             using children distinct_children children_h children_h'
             by (metis children' distinct_remove1 returns_result_eq)
         next
           case False
           then show ?thesis
             using children distinct_children children_eq[OF False]
             using children' distinct_lists_children h0
             using select_result_I2 by fastforce
         qed
 
         then show "distinct |h' \<turnstile> get_child_nodes x|\<^sub>r"
           using children' by(auto simp add: )
       next
         fix x y
         assume 5: "x |\<in>| object_ptr_kinds h'" and 6: "y |\<in>| object_ptr_kinds h'" and 7: "x \<noteq> y"
         obtain children_x where children_x: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x"
           by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_y where children_y: "h \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y"
           by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_x' where children_x': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x'"
           using children_eq children_h' children_x by fastforce
         obtain children_y' where children_y': "h' \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y'"
           using children_eq children_h' children_y by fastforce
         have "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r))"
           using h0 by(auto simp add: a_distinct_lists_def)
         then have 8: "set children_x \<inter> set children_y = {}"
           using "7" assms(1) children_x children_y local.heap_is_wellformed_one_parent by blast
         have "set children_x' \<inter> set children_y' = {}"
         proof (cases "ptr = x")
           case True
           then have "ptr \<noteq> y"
             by(simp add: 7)
           have "children_x' = remove1 child children_x"
             using children_h children_h' children_x children_x' True returns_result_eq by fastforce
           moreover have "children_y' = children_y"
             using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
           ultimately show ?thesis
             using 8 set_remove1_subset by fastforce
         next
           case False
           then show ?thesis
           proof (cases "ptr = y")
             case True
             have "children_y' = remove1 child children_y"
               using children_h children_h' children_y children_y' True returns_result_eq by fastforce
             moreover have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             ultimately show ?thesis
               using 8 set_remove1_subset by fastforce
           next
             case False
             have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             moreover have "children_y' = children_y"
               using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
             ultimately show ?thesis
               using 8 by simp
           qed
         qed
         then show "set |h' \<turnstile> get_child_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_child_nodes y|\<^sub>r = {}"
           using children_x' children_y'
           by (metis (no_types, lifting) select_result_I2)
       qed
     next
       assume 2: "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       then have 4: "distinct  (sorted_list_of_set (fset (document_ptr_kinds h')))"
         by simp
       have 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')))))"
         using h0
         by(simp add: a_distinct_lists_def document_ptr_kinds_eq3)
 
       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[OF 4[unfolded document_ptr_kinds_eq3]])
         fix x
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
         have 5: "distinct |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
           using distinct_lists_disconnected_nodes[OF h0] 4 get_disconnected_nodes_ok
           by (simp add: type_wf document_ptr_kinds_eq3 select_result_I)
         show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
         proof (cases "x = owner_document")
           case True
           have "child \<notin> set |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using child_not_in  document_ptr_kinds_eq2 "4" by fastforce
           moreover have "|h' \<turnstile> get_disconnected_nodes x|\<^sub>r = child # |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using disconnected_nodes_h' disconnected_nodes_h unfolding True
             by(simp)
           ultimately show ?thesis
             using 5 unfolding True
             by simp
         next
           case False
           show ?thesis
             using "5" False disconnected_nodes_eq2 by auto
         qed
       next
         fix x y
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
           and 5: "y \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))" and "x \<noteq> y"
         obtain disc_nodes_x where disc_nodes_x: "h \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y where disc_nodes_y: "h \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of y] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_x' where disc_nodes_x': "h' \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x'"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y' where disc_nodes_y': "h' \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y'"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of y] document_ptr_kinds_eq2
           by auto
         have "distinct
                (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
           using h0 by (simp add: a_distinct_lists_def)
         then have 6: "set disc_nodes_x \<inter> set disc_nodes_y = {}"
           using \<open>x \<noteq> y\<close> assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent
           by blast
 
         have "set disc_nodes_x' \<inter> set disc_nodes_y' = {}"
         proof (cases "x = owner_document")
           case True
           then have "y \<noteq> owner_document"
             using \<open>x \<noteq> y\<close> by simp
           then have "disc_nodes_y' = disc_nodes_y"
             using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y'
             by auto
           have "disc_nodes_x' = child # disc_nodes_x"
             using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h returns_result_eq
             by fastforce
           have "child \<notin> set disc_nodes_y"
             using child_not_in  disc_nodes_y 5
             using document_ptr_kinds_eq2  by fastforce
           then show ?thesis
             apply(unfold \<open>disc_nodes_x' = child # disc_nodes_x\<close> \<open>disc_nodes_y' = disc_nodes_y\<close>)
             using 6 by auto
         next
           case False
           then show ?thesis
           proof (cases "y = owner_document")
             case True
             then have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x' by auto
             have "disc_nodes_y' = child # disc_nodes_y"
               using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h returns_result_eq
               by fastforce
             have "child \<notin> set disc_nodes_x"
               using child_not_in  disc_nodes_x 4
               using document_ptr_kinds_eq2  by fastforce
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = child # disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           next
             case False
             have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x' by auto
             have "disc_nodes_y' = disc_nodes_y"
               using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y' by auto
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           qed
         qed
         then show "set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
           using disc_nodes_x' disc_nodes_y' by auto
       qed
     next
       fix x xa xb
       assume 1: "xa \<in> fset (object_ptr_kinds h')"
         and 2: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 3: "xb \<in> fset (document_ptr_kinds h')"
         and 4: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       obtain disc_nodes where disc_nodes: "h \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of xb] document_ptr_kinds_eq2 by auto
       obtain disc_nodes' where disc_nodes': "h' \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes'"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of xb]  document_ptr_kinds_eq2 by auto
 
       obtain children where children: "h \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children"
         by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E
             local.known_ptrs_known_ptr object_ptr_kinds_eq3)
       obtain children' where children': "h' \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children'"
         using children children_eq children_h' by fastforce
       have "\<And>x. x \<in> set |h \<turnstile> get_child_nodes xa|\<^sub>r \<Longrightarrow> x \<in> set |h \<turnstile> get_disconnected_nodes xb|\<^sub>r \<Longrightarrow> False"
         using 1 3
         apply(fold \<open> object_ptr_kinds h =  object_ptr_kinds h'\<close>)
         apply(fold \<open> document_ptr_kinds h =  document_ptr_kinds h'\<close>)
         using children disc_nodes h0 apply(auto simp add: a_distinct_lists_def)[1]
         by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2)
       then have 5: "\<And>x. x \<in> set children \<Longrightarrow> x \<in> set disc_nodes \<Longrightarrow> False"
         using children disc_nodes  by fastforce
       have 6: "|h' \<turnstile> get_child_nodes xa|\<^sub>r = children'"
         using children' by simp
       have 7: "|h' \<turnstile> get_disconnected_nodes xb|\<^sub>r = disc_nodes'"
         using disc_nodes' by simp
       have "False"
       proof (cases "xa = ptr")
         case True
         have "distinct children_h"
           using children_h distinct_lists_children h0 \<open>known_ptr ptr\<close> by blast
         have "|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h"
           using children_h'
-          bysimp
+          by simp
         have "children = children_h"
           using True children children_h by auto
         show ?thesis
           using disc_nodes' children' 5 2 4 children_h \<open>distinct children_h\<close> disconnected_nodes_h'
           apply(auto simp add: 6 7
               \<open>xa = ptr\<close> \<open>|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h\<close> \<open>children = children_h\<close>)[1]
           by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h
               select_result_I2 set_ConsD)
       next
         case False
         have "children' = children"
           using children' children children_eq[OF False[symmetric]]
           by auto
         then show ?thesis
         proof (cases "xb = owner_document")
           case True
           then show ?thesis
             using disc_nodes disconnected_nodes_h disconnected_nodes_h'
             using "2" "4" "5" "6" "7" False \<open>children' = children\<close> assms(1) child_in_children_h
               child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap
               list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD
             by (metis (no_types, opaque_lifting) assms(3) type_wf)
         next
           case False
           then show ?thesis
             using "2" "4" "5" "6" "7" \<open>children' = children\<close> disc_nodes disc_nodes'
               disconnected_nodes_eq returns_result_eq
             by metis
         qed
       qed
       then show "x \<in> {}"
         by simp
     qed
   }
 
   ultimately show "heap_is_wellformed h'"
     using heap_is_wellformed_def by blast
 qed
 
 lemma remove_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> remove child \<rightarrow>\<^sub>h h'"
     and "known_ptrs h"
     and type_wf: "type_wf h"
   shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
   using assms
   by(auto simp add: remove_def intro: remove_child_heap_is_wellformed_preserved
       elim!: bind_returns_heap_E2 split: option.splits)
 
 lemma remove_child_removes_child:
   assumes wellformed: "heap_is_wellformed h"
     and remove_child: "h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'"
     and children: "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "child \<notin> set children"
 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(2)
     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 "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 remove_child])
     unfolding remove_child_locs_def
     using set_child_nodes_pointers_preserved set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   moreover have "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF remove_child_writes assms(2)]
     using set_child_nodes_types_preserved set_disconnected_nodes_types_preserved type_wf
     unfolding remove_child_locs_def
     apply(auto simp add: reflp_def transp_def)[1]
     by blast
   ultimately show ?thesis
     using remove_child_removes_parent remove_child_heap_is_wellformed_preserved child_parent_dual
     by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child
         returns_result_eq type_wf wellformed)
 qed
 
 lemma remove_child_removes_first_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
   assumes "h \<turnstile> remove_child ptr node_ptr \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
 proof -
   obtain h2 disc_nodes owner_document where
     "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document" and
     "h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h2: "h \<turnstile> set_disconnected_nodes owner_document (node_ptr # disc_nodes) \<rightarrow>\<^sub>h h2" and
     "h2 \<turnstile> set_child_nodes ptr children \<rightarrow>\<^sub>h h'"
     using assms(5)
     apply(auto simp add: remove_child_def
         dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1]
     by(auto elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])
   have "known_ptr ptr"
     by (meson assms(3) assms(4) is_OK_returns_result_I get_child_nodes_ptr_in_heap known_ptrs_known_ptr)
   moreover have "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
     apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 assms(4)])
     using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers
     by fast
   moreover 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 \<open>type_wf h\<close> set_disconnected_nodes_types_preserved
     by(auto simp add:  reflp_def transp_def)
   ultimately show ?thesis
     using set_child_nodes_get_child_nodes\<open>h2 \<turnstile> set_child_nodes ptr children \<rightarrow>\<^sub>h h'\<close>
     by fast
 qed
 
 lemma remove_removes_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children"
   assumes "h \<turnstile> remove node_ptr \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
 proof -
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r Some ptr"
     using child_parent_dual assms by fastforce
   show ?thesis
     using assms remove_child_removes_first_child
     by(auto simp add: remove_def
         dest!: bind_returns_heap_E3[rotated, OF \<open>h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r Some ptr\<close>, rotated]
         bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])
 qed
 
 lemma remove_for_all_empty_children:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "h \<turnstile> forall_M remove children \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
   using assms
 proof(induct children arbitrary: h h')
   case Nil
   then show ?case
     by simp
 next
   case (Cons a children)
   have "h \<turnstile> get_parent a \<rightarrow>\<^sub>r Some ptr"
     using child_parent_dual Cons by fastforce
   with Cons show ?case
   proof(auto elim!: bind_returns_heap_E)[1]
     fix h2
     assume 0: "(\<And>h h'. 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 [])"
       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 a # children"
       and 5: "h \<turnstile> get_parent a \<rightarrow>\<^sub>r Some ptr"
       and 7: "h \<turnstile> remove a \<rightarrow>\<^sub>h h2"
       and 8: "h2 \<turnstile> forall_M remove children \<rightarrow>\<^sub>h h'"
     then have "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
       using remove_removes_child by blast
 
     moreover have "heap_is_wellformed h2"
       using 7 1 2 3 remove_child_heap_is_wellformed_preserved(3)
       by(auto simp add: remove_def
           elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
           split: option.splits)
     moreover have "type_wf h2"
       using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF remove_writes 7]
       using \<open>type_wf h\<close> remove_child_types_preserved
       by(auto simp add: a_remove_child_locs_def reflp_def transp_def)
     moreover have "object_ptr_kinds h = object_ptr_kinds h2"
       using 7
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF remove_writes])
       using remove_child_pointers_preserved
       by (auto simp add: reflp_def transp_def)
     then have "known_ptrs h2"
       using 3  known_ptrs_preserved by blast
 
     ultimately show "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
       using 0 8 by fast
   qed
 qed
 end
 
 locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs
   + l_get_child_nodes_defs + l_remove_defs +
   assumes remove_child_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes remove_child_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes remove_child_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
   assumes remove_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes remove_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes remove_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> remove child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
   assumes 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"
   assumes 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"
   assumes 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"
   assumes 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 []"
 
 interpretation i_remove_child_wf2?: 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 parent_child_rel
   by unfold_locales
 
 declare 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_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_heap_is_wellformed_preserved apply(fast, fast, fast)
   using remove_heap_is_wellformed_preserved apply(fast, fast, 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
 
 
 
 subsection \<open>adopt\_node\<close>
 
 locale 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 +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_heap_is_wellformed
 begin
 lemma adopt_node_removes_first_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h'"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r node # children"
   shows "h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
 proof -
   obtain old_document parent_opt h2 where
     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
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node }
                                | None \<Rightarrow> do { 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 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 h'"
     using assms(4)
     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 "h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h2 remove_child_removes_first_child assms(1) assms(2) assms(3) assms(5)
     by (metis list.set_intros(1) local.child_parent_dual option.simps(5) parent_opt returns_result_eq)
   then
   show ?thesis
     using h'
     by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]
         split: if_splits)
 qed
 
 
 lemma adopt_node_document_in_heap:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> ok (adopt_node owner_document node)"
   shows "owner_document |\<in>| document_ptr_kinds h"
 proof -
   obtain old_document parent_opt h2 h' where
     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
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node } | None \<Rightarrow> do { 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 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 h'"
     using assms(4)
     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
       using old_document get_owner_document_owner_document_in_heap assms(1) assms(2) assms(3)
       by auto
   next
     case False
 
     then obtain h3 old_disc_nodes disc_nodes where
       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 node old_disc_nodes) \<rightarrow>\<^sub>h h3" and
       old_disc_nodes: "h3 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
       h': "h3 \<turnstile> set_disconnected_nodes owner_document (node # disc_nodes) \<rightarrow>\<^sub>h h'"
       using h'
       by(auto elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] )
     then have "owner_document |\<in>| document_ptr_kinds h3"
       by (meson is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap)
 
     moreover have "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)
     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_disconnected_nodes_writes h3])
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def)
 
     ultimately show ?thesis
       by(auto simp add: document_ptr_kinds_def)
   qed
 qed
 end
 
 locale l_adopt_node_wf2\<^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 +
   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 +
   l_get_root_node +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma adopt_node_removes_child_step:
   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 get_parent_pure
     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_removes_child:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'"
   shows "\<And>ptr' children'.
   h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> node_ptr \<notin> set children'"
   using adopt_node_removes_child_step assms by blast
 
 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 known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "known_ptrs h2"
     using h2 remove_child_preserves_known_ptrs known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
   proof(cases "document_ptr = old_document")
     case True
     then show ?thesis
       using h' wellformed_h2 \<open>type_wf h2\<close> \<open>known_ptrs 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 "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
 
     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 "a_owner_document_valid h"
         using assms(1) heap_is_wellformed_def by(simp add: 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 "a_distinct_lists h2"
         using 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: 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 "a_acyclic_heap h2"
       using wellformed_h2 by (simp add: 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 parent_child_rel_def
         by(simp)
     qed
     then have "a_acyclic_heap h'"
       using \<open>a_acyclic_heap h2\<close> acyclic_heap_def acyclic_subset by blast
 
     moreover have "a_all_ptrs_in_heap h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_all_ptrs_in_heap h3"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1]
        apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1))
       by (metis (no_types, lifting) \<open>child \<in> set disc_nodes_old_document_h2\<close> \<open>type_wf h2\<close>
           disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2
           document_ptr_kinds_eq3_h2 in_set_remove1 local.get_disconnected_nodes_ok
           local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 returns_result_select_result
           select_result_I2 wellformed_h2)
     then have "a_all_ptrs_in_heap h'"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1]
        apply (simp add: children_eq2_h3 object_ptr_kinds_h3_eq3 subset_code(1))
       by (metis (no_types, 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
           finite_set_in local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           select_result_I2 set_ConsD subset_code(1) wellformed_h2)
 
     moreover have "a_owner_document_valid h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_owner_document_valid h'"
       apply(simp add: 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 (smt 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) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2
           set_subset_Cons subset_code(1))
 
     have a_distinct_lists_h2: "a_distinct_lists h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_distinct_lists h'"
       apply(auto simp add: 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 fmember.rep_eq set_sorted_list_of_set)
                 ultimately show ?thesis
                   using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr = y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3
                   by auto
               next
                 case False
                 then show ?thesis
                   using 5
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr \<noteq> y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close>
                     disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
                   by (metis \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}\<close>
                       empty_iff inf.idem)
               qed
             qed
           qed
         qed
       qed
     next
       fix x xa xb
       assume 0: "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                                   (sorted_list_of_set (fset (object_ptr_kinds h')))))"
         and 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                    (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
         and 2: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h2). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         and 3: "xa |\<in>| object_ptr_kinds h'"
         and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 5: "xb |\<in>| document_ptr_kinds h'"
         and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       then show False
         using \<open>child \<in> set disc_nodes_old_document_h2\<close> disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2
           document_ptr_kinds_eq2_h3  old_document_in_heap
         apply(auto)[1]
         apply(cases "xb = old_document")
       proof -
         assume a1: "xb = old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a3: "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 child disc_nodes_old_document_h2"
         assume a4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a5: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f6: "old_document |\<in>| document_ptr_kinds h'"
           using a1 \<open>xb |\<in>| document_ptr_kinds h'\<close> by blast
         have f7: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a2 by simp
         have "x \<in> set disc_nodes_old_document_h2"
           using f6 a3 a1 by (metis (no_types) \<open>type_wf h'\<close> \<open>x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r\<close>
               disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq
               returns_result_select_result set_remove1_subset subsetCE)
         then have "set |h' \<turnstile> get_child_nodes xa|\<^sub>r \<inter>  set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
           using f7 f6 a5 a4 \<open>xa |\<in>| object_ptr_kinds h'\<close>
           by fastforce
         then show ?thesis
           using \<open>x \<in> set disc_nodes_old_document_h2\<close> a1 a4 f7 by blast
       next
         assume a1: "xb \<noteq> old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3"
         assume a3: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a4: "xa |\<in>| object_ptr_kinds h'"
         assume a5: "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r child # disc_nodes_document_ptr_h3"
         assume a6: "old_document |\<in>| document_ptr_kinds h'"
         assume a7: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
         assume a8: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a10: "\<And>doc_ptr. old_document \<noteq> doc_ptr
                \<Longrightarrow> |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a11: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr
                \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a12: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f13: "\<And>d. d \<notin> set |h' \<turnstile> document_ptr_kinds_M|\<^sub>r \<or> h2 \<turnstile> ok get_disconnected_nodes d"
           using a9 \<open>type_wf h2\<close> get_disconnected_nodes_ok
           by simp
         then have f14: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a6 a3 by simp
         have "x \<notin> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
           using a12 a8 a4 \<open>xb |\<in>| document_ptr_kinds h'\<close>
           by (meson UN_I disjoint_iff_not_equal fmember.rep_eq)
         then have "x = child"
           using f13 a11 a10 a7 a5 a2 a1
           by (metis (no_types, lifting) select_result_I2 set_ConsD)
         then have "child \<notin> set disc_nodes_old_document_h2"
           using f14 a12 a8 a6 a4
           by (metis \<open>type_wf h'\<close> adopt_node_removes_child assms(1) assms(2) type_wf
               get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3
               object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result)
         then show ?thesis
           using \<open>child \<in> set disc_nodes_old_document_h2\<close> by fastforce
       qed
     qed
     ultimately show ?thesis
       using \<open>type_wf h'\<close> \<open>known_ptrs h'\<close> \<open>a_owner_document_valid h'\<close> heap_is_wellformed_def by blast
   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 i_adopt_node_wf?: 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 adopt_node_locs 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(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>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 heap_is_wellformed parent_child_rel get_root_node get_root_node_locs
   by(simp add: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs
   + l_get_child_nodes_defs + l_get_disconnected_nodes_defs +
   assumes adopt_node_preserves_wellformedness:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h' \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> heap_is_wellformed h'"
   assumes adopt_node_removes_child:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h2
                           \<Longrightarrow> h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> known_ptrs h
                           \<Longrightarrow> type_wf h \<Longrightarrow> node_ptr \<notin> set children"
   assumes adopt_node_node_in_disconnected_nodes:
     "heap_is_wellformed h \<Longrightarrow> h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes
                           \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow> node_ptr \<in> set disc_nodes"
   assumes 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"
   assumes 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"
 
 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"
   using heap_is_wellformed_is_l_heap_is_wellformed known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_adopt_node_wf_def l_adopt_node_wf_axioms_def)[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
 
 
 subsection \<open>insert\_before\<close>
 
 locale l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node_wf +
   l_set_disconnected_nodes_get_child_nodes +
   l_heap_is_wellformed
 begin
 lemma insert_before_removes_child:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "ptr \<noteq> ptr'"
   assumes "h \<turnstile> insert_before ptr node child \<rightarrow>\<^sub>h h'"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r node # children"
   shows "h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
 proof -
   obtain owner_document h2 h3 disc_nodes reference_child where
     "h \<turnstile> (if Some node = child then a_next_sibling node else return child) \<rightarrow>\<^sub>r reference_child" and
     "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
     "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes" and
     h3: "h2 \<turnstile> set_disconnected_nodes owner_document (remove1 node disc_nodes) \<rightarrow>\<^sub>h h3" and
     h': "h3 \<turnstile> a_insert_node ptr node reference_child \<rightarrow>\<^sub>h h'"
     using assms(5)
     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_child_nodes_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
         bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         split: if_splits option.splits)
 
   have "h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h2 adopt_node_removes_first_child assms(1) assms(2) assms(3) assms(6)
     by simp
   then have "h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using h3
     by(auto simp add: set_disconnected_nodes_get_child_nodes
         dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes])
   then show ?thesis
     using h' assms(4)
     apply(auto simp add: a_insert_node_def
         elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1]
     by(auto simp add: set_child_nodes_get_child_nodes_different_pointers
         elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes])
 qed
 end
 
 locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs
   + l_insert_before_defs + l_get_child_nodes_defs +
   assumes insert_before_removes_child:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> ptr \<noteq> ptr'
                         \<Longrightarrow> h \<turnstile> insert_before ptr node child \<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"
 
 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 get_ancestors_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 heap_is_wellformed type_wf known_ptr known_ptrs insert_before 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
 
 locale l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_child_nodes_get_disconnected_nodes +
   l_remove_child +
   l_get_root_node_wf +
   l_set_disconnected_nodes_get_disconnected_nodes_wf +
   l_set_disconnected_nodes_get_ancestors +
   l_get_ancestors_wf +
   l_get_owner_document +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma insert_before_heap_is_wellformed_preserved:
   assumes wellformed: "heap_is_wellformed h"
     and insert_before: "h \<turnstile> insert_before ptr node child \<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'"
 proof -
   obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors 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(2)
     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 "known_ptr ptr"
     by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs
         l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)
 
   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 type_wf adopt_node_types_preserved
     by(auto simp add: a_remove_child_locs_def 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_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 "known_ptrs h2"
     using known_ptrs object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF wellformed h2] known_ptrs type_wf .
 
   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 "known_ptrs h3"
     using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \<open>known_ptrs h2\<close> by blast
 
   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
 
   show "known_ptrs h'"
     using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \<open>known_ptrs h3\<close> 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 wellformed 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 ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_ok object_ptr_kinds_M_eq2_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close>
     by (metis is_OK_returns_result_E object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2)
   have ancestors_h3: "h3 \<turnstile> get_ancestors ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_separate_forwards)
     using \<open>heap_is_wellformed h2\<close> ancestors_h2
     by (auto simp add: set_disconnected_nodes_get_ancestors)
   have node_not_in_ancestors_h2: "cast node \<notin> set ancestors_h2"
     apply(rule get_ancestors_remains_not_in_ancestors[OF assms(1) wellformed_h2 ancestors ancestors_h2])
     using adopt_node_children_subset using h2 \<open>known_ptrs h\<close> \<open> type_wf h\<close> apply(blast)
     using node_not_in_ancestors apply(blast)
     using object_ptr_kinds_M_eq3_h apply(blast)
     using \<open>known_ptrs h\<close> apply(blast)
     using \<open>type_wf h\<close> apply(blast)
     using \<open>type_wf h2\<close> by blast
 
   moreover have "a_acyclic_heap h'"
   proof -
     have "acyclic (parent_child_rel h2)"
       using wellformed_h2  by (simp add: heap_is_wellformed_def acyclic_heap_def)
     then have "acyclic (parent_child_rel h3)"
       by(auto simp add: 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_parent_child_rel node_not_in_ancestors_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close>
       using ancestors_h2 wellformed_h2 by blast
     then have "cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h3)\<^sup>*}"
       by(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
     moreover 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: 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)
     ultimately show ?thesis
       by(auto simp add: acyclic_heap_def)
   qed
 
 
   moreover have "a_all_ptrs_in_heap h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   have "a_all_ptrs_in_heap h'"
   proof -
     have "a_all_ptrs_in_heap h3"
       using \<open>a_all_ptrs_in_heap h2\<close>
       apply(auto simp add: 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 \<open>known_ptrs h2\<close> \<open>type_wf h3\<close> children_eq_h2 local.get_child_nodes_ok
           local.heap_is_wellformed_children_in_heap local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h2
           returns_result_select_result wellformed_h2)
       by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_h2
           disconnected_nodes_h3 document_ptr_kinds_commutes finite_set_in node_ptr_kinds_commutes
           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>a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq2_h3)[1]
       by (metis children_eq_h2 l_heap_is_wellformed.heap_is_wellformed_children_in_heap
           local.l_heap_is_wellformed_axioms node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h'
           object_ptr_kinds_M_eq3_h2 wellformed_h2)
 
     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 finite_set_in insert_before_list_in_set
           node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h'
           object_ptr_kinds_M_eq3_h2)
     then show ?thesis
       using \<open>a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def
           node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1]
       using children_eq_h3 children_h'
        apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD)
       by (metis (no_types) \<open>type_wf h'\<close> disconnected_nodes_eq2_h3 disconnected_nodes_eq_h3
           finite_set_in is_OK_returns_result_I local.get_disconnected_nodes_ok
           local.get_disconnected_nodes_ptr_in_heap returns_result_select_result subsetD)
   qed
 
   moreover have "a_distinct_lists h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h3"
   proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2
       children_eq2_h2 intro!: distinct_concat_map_I)[1]
     fix x
     assume 1: "x |\<in>| document_ptr_kinds h3"
       and 2: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                         (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
     show "distinct |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3]
         disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1
       by (metis (full_types) distinct_remove1 finite_fset fmember.rep_eq set_sorted_list_of_set)
   next
     fix x y xa
     assume 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                           (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and 2: "x |\<in>| document_ptr_kinds h3"
       and 3: "y |\<in>| document_ptr_kinds h3"
       and 4: "x \<noteq> y"
       and 5: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and 6: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r"
     show False
     proof (cases "x = owner_document")
       case True
       then have "y \<noteq> owner_document"
         using 4 by simp
       show ?thesis
         using distinct_concat_map_E(1)[OF 1]
         using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3]  select_result_I2[OF disconnected_nodes_h2]
         apply(auto simp add: True disconnected_nodes_eq2_h2[OF \<open>y \<noteq> owner_document\<close>])[1]
         by (metis (no_types, 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 fmember.rep_eq notin_set_remove1 select_result_I2
             set_sorted_list_of_set
           by (metis (no_types, lifting))
       qed
     qed
   next
     fix x xa xb
     assume 1: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h3 \<turnstile> get_child_nodes x|\<^sub>r)
                      \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 2: "xa |\<in>| object_ptr_kinds h3"
       and 3: "x \<in> set |h3 \<turnstile> get_child_nodes xa|\<^sub>r"
       and 4: "xb |\<in>| document_ptr_kinds h3"
       and 5: "x \<in> set |h3 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     have 6: "set |h3 \<turnstile> get_child_nodes xa|\<^sub>r \<inter> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
       using 1 2 4
       by (metis \<open>type_wf h2\<close> children_eq2_h2 document_ptr_kinds_commutes known_ptrs
           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 "a_distinct_lists h'"
   proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3
       disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)[1]
     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 known_ptrs 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.a_distinct_lists h3\<close> local.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>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disconnected_nodes_eq_h3
             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 "a_owner_document_valid h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: 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 children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2
         disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set
         object_ptr_kinds_M_eq3_h' ptr_in_heap select_result_I2)
 
   ultimately show "heap_is_wellformed h'"
     by (simp add: heap_is_wellformed_def)
 qed
 end
 
 locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs
   + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs +
   assumes insert_before_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes insert_before_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes insert_before_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> insert_before ptr child ref \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
 
 interpretation i_insert_before_wf2?: l_insert_before_wf2\<^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 get_ancestors_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 remove_child
   remove_child_locs get_root_node get_root_node_locs
   by(simp add: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma insert_before_wf2_is_l_insert_before_wf2 [instances]:
   "l_insert_before_wf2 type_wf known_ptr known_ptrs insert_before heap_is_wellformed"
   apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1]
   using insert_before_heap_is_wellformed_preserved apply(fast, fast, fast)
   done
 
 locale l_append_child_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_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_insert_before_wf +
   l_insert_before_wf2  +
   l_get_child_nodes
 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_preserves_type_wf
       insert_before_preserves_known_ptrs insert_before_heap_is_wellformed_preserved)
 
 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 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 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_heap_is_wellformed_preserved insert_before_preserves_known_ptrs
       insert_before_preserves_type_wf 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
 
 locale l_append_child_wf = l_type_wf + l_known_ptrs + l_append_child_defs + l_heap_is_wellformed_defs +
   assumes append_child_preserves_type_wf:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> type_wf h'"
   assumes append_child_preserves_known_ptrs:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                           \<Longrightarrow> known_ptrs h'"
   assumes append_child_heap_is_wellformed_preserved:
     "type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> heap_is_wellformed h \<Longrightarrow> h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'
                \<Longrightarrow> heap_is_wellformed h'"
 
 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 get_ancestors_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)
 
 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+
 
 
 subsection \<open>create\_element\<close>
 
 locale l_create_element_wf\<^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 parent_child_rel +
   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>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 create_element known_ptr +
   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_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_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"
 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 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 local.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)
 
   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_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
       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 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 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_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 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 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 "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 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 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 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 "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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)[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 local.get_child_nodes_ok local.known_ptrs_known_ptr
         local.parent_child_rel_child_in_heap local.parent_child_rel_child_nodes2 node_ptr_kinds_commutes
         node_ptr_kinds_eq_h returns_result_select_result)
     by (metis assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funion_iff
         local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h
         returns_result_select_result)
   then have "a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "a_all_ptrs_in_heap h'"
     by (smt \<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_h3
         disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
         document_ptr_kinds_eq_h3 finite_set_in h' is_OK_returns_result_I
         l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
         local.a_all_ptrs_in_heap_def local.get_child_nodes_ptr_in_heap
         local.l_set_disconnected_nodes_get_disconnected_nodes_axioms node_ptr_kinds_commutes
         object_ptr_kinds_eq_h2 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 a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem 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 "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
 
     using \<open>h2 \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: 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 local.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>local.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
         local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result)
 
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)
   then have "a_distinct_lists h'"
   proof(auto simp add: 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>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disc_nodes_h3 distinct.simps(2)
           distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq
           returns_result_select_result)
   next
     fix x y xa
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                             (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
       and "y |\<in>| document_ptr_kinds h3"
       and "x \<noteq> y"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     moreover have "set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
       using calculation by(auto dest: distinct_concat_map_E(1))
     ultimately show "False"
       apply(-)
       apply(cases "x = document_ptr")
        apply (smt NodeMonad.ptr_kinds_ptr_kinds_M \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
           \<open>local.a_all_ptrs_in_heap h\<close>
           disc_nodes_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           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)
       by (smt NodeMonad.ptr_kinds_ptr_kinds_M
           \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close> \<open>local.a_all_ptrs_in_heap h\<close>
           disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
           disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply -
       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>a_distinct_lists h3\<close> children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h'
           select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes)
       by (metis "3" "4" "5" "6" \<open>a_distinct_lists h3\<close> \<open>type_wf h3\<close> children_eq2_h3
           distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(auto simp add: a_owner_document_valid_def)[1]
     apply(auto simp add:  object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: object_ptr_kinds_eq_h2)[1]
     apply(auto simp add:  document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: document_ptr_kinds_eq_h2)[1]
     apply(auto simp add:  node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )[1]
      apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
         disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
         disconnected_nodes_eq2_h3)[1]
      apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
     apply(simp add: object_ptr_kinds_eq_h)
     by(metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M
         \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close> children_eq2_h children_eq2_h2
         children_eq2_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
         document_ptr_kinds_eq_h finite_set_in h'
         l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
         list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
         node_ptr_kinds_commutes select_result_I2)
 
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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
   using instances
   by(auto simp add: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsection \<open>create\_character\_data\<close>
 
 locale l_create_character_data_wf\<^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 parent_child_rel
   + 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_create_character_data\<^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_val set_val_locs type_wf create_character_data known_ptr
   + 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_new_character_data
   type_wf
   + l_known_ptrs
   known_ptr known_ptrs
   for known_ptr :: "(_::linorder) 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 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_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_character_data ::
     "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) character_data_ptr) prog"
     and known_ptrs :: "(_) 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: create_character_data_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF 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: 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.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 set_val_writes h3])
     using 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
       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 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 set_val_writes h3])
     using 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 "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       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 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 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 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_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 get_disconnected_nodes_reads 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 "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 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 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 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 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 acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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)[1]
     using node_ptr_kinds_eq_h \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
      apply (metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \<open>parent_child_rel h = parent_child_rel h2\<close>
         children_eq2_h finite_set_in finsert_iff funion_finsert_right local.parent_child_rel_child
         local.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 assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funionI1
         local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap
         node_ptr_kinds_eq_h returns_result_select_result)
   then have "a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "a_all_ptrs_in_heap h'"
     by (smt   character_data_ptr_kinds_commutes children_eq2_h3 disc_nodes_document_ptr_h2
         disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
         finite_set_in h' h2 local.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_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_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 a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem 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 "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: 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 local.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>local.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
         local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result)
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)[1]
   then have "a_distinct_lists h'"
   proof(auto simp add: 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 new_character_data_ptr \<notin> set disc_nodes_h3\<close>
           \<open>a_distinct_lists h3\<close> \<open>type_wf h'\<close> disc_nodes_h3 distinct.simps(2)
           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 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>
           \<open>local.a_all_ptrs_in_heap h\<close> disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal
           document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                   \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply(cases "xb = document_ptr")
        apply (metis (no_types, opaque_lifting) "3" "4" "6"
           \<open>\<And>p. p |\<in>| object_ptr_kinds h3 \<Longrightarrow> cast new_character_data_ptr \<notin> set |h3 \<turnstile> get_child_nodes p|\<^sub>r\<close>
           \<open>a_distinct_lists h3\<close> children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h'
           select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes)
       by (metis "3" "4" "5" "6" \<open>a_distinct_lists h3\<close> \<open>type_wf h3\<close> children_eq2_h3
           distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(simp add: a_owner_document_valid_def)
     apply(simp add: object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )
     apply(simp add: object_ptr_kinds_eq_h2)
     apply(simp add: document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )
     apply(simp add: document_ptr_kinds_eq_h2)
     apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )
     apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )
     apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] disconnected_nodes_eq2_h
         disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1]
      apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
     apply(simp add: object_ptr_kinds_eq_h)
     by (metis (mono_tags, lifting) \<open>cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close>
         children_eq2_h disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h'
         l_ptr_kinds_M.ptr_kinds_ptr_kinds_M
         l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
         list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms object_ptr_kinds_M_def
         select_result_I2)
 
 
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_character_data_wf?: l_create_character_data_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 get_disconnected_nodes get_disconnected_nodes_locs
   heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_character_data known_ptrs
   using instances
   by (auto simp add: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsection \<open>create\_document\<close>
 
 locale l_create_document_wf\<^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 parent_child_rel
   + 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_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 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_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_val_locs :: "(_) character_data_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and create_document :: "((_) heap, exception, (_) document_ptr) prog"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
 begin
 
 lemma create_document_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> create_document \<rightarrow>\<^sub>h h'"
     and "type_wf h"
     and "known_ptrs h"
   shows "heap_is_wellformed h'"
 proof -
   obtain new_document_ptr where
     new_document_ptr: "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr" and
     h': "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
     using assms(2)
     apply(simp add: create_document_def)
     using new_document_ok by blast
 
   have "new_document_ptr \<notin> set |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
   have "new_document_ptr |\<notin>| document_ptr_kinds h"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr |\<notin>| object_ptr_kinds h"
     by simp
 
   have object_ptr_kinds_eq: "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_document_ptr|}"
     using new_document_new_ptr h' new_document_ptr by blast
   then have node_ptr_kinds_eq: "node_ptr_kinds h' = node_ptr_kinds h"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h' = character_data_ptr_kinds h"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h: "element_ptr_kinds h' = element_ptr_kinds h"
     using object_ptr_kinds_eq
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h' = document_ptr_kinds h |\<union>| {|new_document_ptr|}"
     using object_ptr_kinds_eq
     apply(auto simp add: document_ptr_kinds_def)[1]
     by (metis (no_types, lifting) document_ptr_kinds_commutes document_ptr_kinds_def finsertI1 fset.map_comp)
 
 
   have 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 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 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 (simp add: heap_is_wellformed_def acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h'"
   proof(auto simp add: 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 "a_acyclic_heap h'"
     by (simp add: acyclic_heap_def)
 
   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 h'"
     apply(auto simp add: 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 local.parent_child_rel_child
       local.parent_child_rel_parent_in_heap node_ptr_kinds_eq
      apply (metis (no_types, lifting) \<open>h' \<turnstile> get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \<rightarrow>\<^sub>r []\<close>
         children_eq2 finite_set_in finsert_iff funion_finsert_right object_ptr_kinds_eq
         select_result_I2 subsetD sup_bot.right_neutral)
     by (metis (no_types, lifting) \<open>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>
         \<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>
         \<open>h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []\<close>
         \<open>parent_child_rel h = parent_child_rel h'\<close> \<open>type_wf h'\<close> assms(1) disconnected_nodes_eq_h
         local.get_disconnected_nodes_ok
         local.heap_is_wellformed_disc_nodes_in_heap local.parent_child_rel_child
         local.parent_child_rel_parent_in_heap
         node_ptr_kinds_eq returns_result_select_result select_result_I2)
   have "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   then have "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] 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]
     using disconnected_nodes_eq_h
       apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.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>local.a_distinct_lists h\<close> assms(3) disconnected_nodes_eq2_h
           local.distinct_lists_no_parent local.get_disconnected_nodes_ok
           returns_result_select_result)
   qed
 
   have "a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: a_owner_document_valid_def)[1]
     by (metis \<open>cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr |\<notin>| object_ptr_kinds h\<close>
         children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in
         funion_iff node_ptr_kinds_eq object_ptr_kinds_eq)
   show "heap_is_wellformed h'"
     using \<open>a_acyclic_heap h'\<close> \<open>a_all_ptrs_in_heap h'\<close> \<open>a_distinct_lists h'\<close> \<open>a_owner_document_valid h'\<close>
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_create_document_wf?: l_create_document_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 get_disconnected_nodes
   get_disconnected_nodes_locs heap_is_wellformed parent_child_rel
   set_val set_val_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_document known_ptrs
   using instances
   by (auto simp add: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 end
diff --git a/thys/List_Update/List_Factoring.thy b/thys/List_Update/List_Factoring.thy
--- a/thys/List_Update/List_Factoring.thy
+++ b/thys/List_Update/List_Factoring.thy
@@ -1,2389 +1,2389 @@
 (*  Title:       List Factoring
     Author:      Max Haslbeck
 *)
 
 section "List factoring technique"
 
 theory List_Factoring
 imports
   Partial_Cost_Model
   MTF2_Effects
 begin
 
 hide_const config compet
 
 subsection "Helper functions"
 
 subsubsection "Helper lemmas"
 
 lemma befaf: assumes "q\<in>set s" "distinct s"
 shows "before q s \<union> {q} \<union> after q s = set s"
 proof -
   have "before q s \<union> {y. index s y = index s q \<and> q \<in> set s}
       = {y. index s y \<le> index s q \<and> q \<in> set s}"
         unfolding before_in_def apply(auto) by (simp add: le_neq_implies_less)
   also have "\<dots> =  {y. index s y \<le> index s q \<and> y\<in> set s \<and> q \<in> set s}"
     apply(auto) by (metis index_conv_size_if_notin index_less_size_conv not_less)
   also with \<open>q \<in> set s\<close> have "\<dots> = {y. index s y \<le> index s q \<and> y\<in> set s}" by auto
   finally have "before q s \<union> {y. index s y = index s q \<and> q \<in> set s} \<union> after q s
       = {y. index s y \<le> index s q \<and> y\<in> set s} \<union> {y. index s y > index s q \<and> y \<in> set s}"
       unfolding before_in_def by simp
   also have "\<dots> = set s" by auto
   finally show ?thesis using assms by simp
 qed
 
 lemma index_sum: assumes "distinct s" "q\<in>set s"
 shows "index s q = (\<Sum>e\<in>set s. if e < q in s then 1 else 0)"
 proof -
   from assms have bia_empty: "before q s \<inter> ({q} \<union> after q s) = {}"
     by(auto simp: before_in_def)
   from befaf[OF assms(2) assms(1)] have "(\<Sum>e\<in>set s. if e < q in s then 1::nat else 0)
     = (\<Sum>e\<in>(before q s \<union> {q} \<union> after q s). if e < q in s then 1 else 0)" by auto
   also have "\<dots> = (\<Sum>e\<in>before q s. if e < q in s then 1 else 0)
             + (\<Sum>e\<in>{q}. if e < q in s then 1 else 0) + (\<Sum>e\<in>after q s. if e < q in s then 1 else 0)"
    proof -
       have "(\<Sum>e\<in>(before q s \<union> {q} \<union> after q s). if e < q in s then 1::nat else 0)
       = (\<Sum>e\<in>(before q s \<union> ({q} \<union> after q s)). if e < q in s then 1::nat else 0)"
         by simp
       also have "\<dots> = (\<Sum>e\<in>before q s. if e < q in s then 1 else 0)
           + (\<Sum>e\<in>({q} \<union> after q s). if e < q in s then 1 else 0)
           - (\<Sum>e\<in>(before q s \<inter> ({q} \<union> after q s)). if e < q in s then 1 else 0)"
           apply(rule sum_Un_nat) by(simp_all)
       also have "\<dots> = (\<Sum>e\<in>before q s. if e < q in s then 1 else 0)
           + (\<Sum>e\<in>({q} \<union> after q s). if e < q in s then 1 else 0)" using bia_empty by auto
       also have "\<dots> = (\<Sum>e\<in>before q s. if e < q in s then 1 else 0)
           + (\<Sum>e\<in>{q}. if e < q in s then 1 else 0) + (\<Sum>e\<in>after q s. if e < q in s then 1 else 0)"
           by (simp add: before_in_def)
       finally show ?thesis .
     qed
   also have "\<dots> = (\<Sum>e\<in>before q s. 1) + (\<Sum>e\<in>({q} \<union> after q s). 0)" apply(auto)
     unfolding before_in_def by auto
   also have "\<dots> = card (before q s)" by auto
   also have "\<dots> = card (set (take (index s q) s))" using before_conv_take[OF assms(2)] by simp
   also have "\<dots> = length (take (index s q) s)" using distinct_card assms(1) distinct_take by metis
   also have "\<dots> = min (length s) (index s q)" by simp
   also have "\<dots> = index s q" using index_le_size[of s q] by(auto)
   finally show ?thesis by simp
 qed
 
 
 subsubsection "ALG"
 
 fun ALG :: "'a \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> ('a list * 'is) \<Rightarrow> nat" where
   "ALG x qs i s = (if x < (qs!i) in fst s then 1::nat else 0)" 
 
 (* no paid exchanges, requested items in state (nice, quickcheck is awesome!) *)
 lemma t\<^sub>p_sumofALG: "distinct (fst s) \<Longrightarrow> snd a = [] \<Longrightarrow> (qs!i)\<in>set (fst s) 
     \<Longrightarrow> t\<^sub>p (fst s) (qs!i) a = (\<Sum>e\<in>set (fst s). ALG e qs i s)"
 unfolding t\<^sub>p_def apply(simp add: split_def )
   using index_sum by metis
 
 lemma t\<^sub>p_sumofALGreal: assumes "distinct (fst s)" "snd a = []" "qs!i \<in> set(fst s)" 
 shows "real(t\<^sub>p (fst s) (qs!i) a) = (\<Sum>e\<in>set (fst s). real(ALG e qs i s))"
 proof -
   from assms have "real(t\<^sub>p (fst s) (qs!i) a) = real(\<Sum>e\<in>set (fst s). ALG e qs i s)"
     using t\<^sub>p_sumofALG by metis
   also have "\<dots> = (\<Sum>e\<in>set (fst s). real (ALG e qs i s))"
     by auto
   finally show ?thesis .
 qed
 
 
 subsubsection "The function steps'"
 
 fun steps' where
   "steps' s _ _ 0 = s"
 | "steps' s [] [] (Suc n) = s"
 | "steps' s (q#qs) (a#as) (Suc n) = steps' (step s q a) qs as n"
 
 lemma steps'_steps: "length as = length qs \<Longrightarrow> steps' s as qs (length as) = steps s as qs"
 by(induct arbitrary: s rule: list_induct2, simp_all)
 
 
 lemma steps'_length: "length qs = length as \<Longrightarrow> n \<le> length as
   \<Longrightarrow> length (steps' s qs as n) = length s"
 apply(induct qs as arbitrary: s  n rule: list_induct2)
   apply(simp)
   apply(case_tac n)
     by (auto)
 
 lemma steps'_set: "length qs = length as \<Longrightarrow> n \<le> length as
   \<Longrightarrow> set (steps' s qs as n) = set s"
 apply(induct qs as arbitrary: s  n rule: list_induct2)
   apply(simp)
   apply(case_tac n)
     by(auto simp: set_step)
 
 lemma steps'_distinct2: "length qs = length as \<Longrightarrow> n \<le> length as
   \<Longrightarrow>  distinct s \<Longrightarrow> distinct (steps' s qs as n)"
 apply(induct qs as arbitrary: s  n rule: list_induct2)
   apply(simp)
   apply(case_tac n)
     by(auto simp: distinct_step)
 
 
 lemma steps'_distinct: "length qs = length as \<Longrightarrow> length as = n
   \<Longrightarrow> distinct (steps' s qs as n) = distinct s"
   by (induct qs as arbitrary: s n rule: list_induct2) (fastforce simp add: distinct_step)+
 
 lemma steps'_dist_perm: "length qs = length as \<Longrightarrow> length as = n
   \<Longrightarrow> dist_perm s s \<Longrightarrow> dist_perm (steps' s qs as n) (steps' s qs as n)"
 using steps'_set steps'_distinct by blast
 
 lemma steps'_rests: "length qs = length as \<Longrightarrow> n \<le> length as \<Longrightarrow> steps' s qs as n = steps' s (qs@r1) (as@r2) n" 
 apply(induct qs as arbitrary: s  n rule: list_induct2)
   apply(simp) apply(case_tac n) by auto
 
 lemma steps'_append: "length qs = length as \<Longrightarrow> length qs = n \<Longrightarrow> steps' s (qs@[q]) (as@[a]) (Suc n) = step (steps' s qs as n) q a"
 apply(induct qs as arbitrary: s  n rule: list_induct2) by auto
 
 subsubsection "\<open>ALG'_det\<close>"
 
 definition "ALG'_det Strat qs init i x = ALG x qs i (swaps (snd (Strat!i)) (steps' init qs Strat i),())"
 
 lemma ALG'_det_append: "n < length Strat \<Longrightarrow> n < length qs \<Longrightarrow> ALG'_det Strat (qs@a) init n x 
                         = ALG'_det Strat qs init n x"
 proof -
   assume qs: "n < length qs"
   assume S: "n < length Strat"
 
   have tt: "(qs @ a) ! n = qs ! n"
     using qs by (simp add: nth_append)
 
   have "steps' init (take n qs) (take n Strat) n = steps' init ((take n qs) @ drop n qs) ((take n Strat) @ (drop n Strat)) n"
        apply(rule steps'_rests)
         using S qs by auto
   then have A: "steps' init (take n qs) (take n Strat) n = steps' init qs Strat n" by auto
   have "steps' init (take n qs) (take n Strat) n = steps' init ((take n qs) @ ((drop n qs)@a)) ((take n Strat) @((drop n Strat)@[])) n"
        apply(rule steps'_rests)
         using S qs by auto
   then have B: "steps' init (take n qs) (take n Strat) n = steps' init (qs@a) (Strat@[]) n"
     by (metis append_assoc List.append_take_drop_id)
   from A B have "steps' init qs Strat n = steps' init (qs@a) (Strat@[]) n" by auto
   then have C: "steps' init qs Strat n = steps' init (qs@a) Strat n" by auto
 
   show ?thesis unfolding ALG'_det_def C
       unfolding ALG.simps tt by auto
 qed 
 
 subsubsection "ALG'"
 
 abbreviation "config'' A qs init n == config_rand A init (take n qs)"
 
 definition "ALG' A qs init i x = E( map_pmf (ALG x qs i) (config'' A qs init i))"
 
 lemma ALG'_refl: "qs!i = x \<Longrightarrow> ALG' A qs init i x = 0"
 unfolding ALG'_def by(simp add: split_def before_in_def)
  
 subsubsection "\<open>ALGxy_det\<close>"
 
 definition ALGxy_det where
   "ALGxy_det A qs init x y = (\<Sum>i\<in>{..<length qs}. (if (qs!i \<in> {y,x}) then ALG'_det A qs init i y + ALG'_det A qs init i x
                                                     else 0::nat))"
 
 lemma ALGxy_det_alternativ: "ALGxy_det A qs init x y
    =  (\<Sum>i\<in>{i. i<length qs \<and> (qs!i \<in> {y,x})}. ALG'_det A qs init i y + ALG'_det A qs init i x)"
 proof -
   have f: "{i. i<length qs} = {..<length qs}" by(auto)
 
   have e: "{i. i<length qs \<and> (qs!i \<in> {y,x})} = {i. i<length qs} \<inter> {i. (qs!i \<in> {y,x})}"
       by auto
   have "(\<Sum>i\<in>{i. i<length qs \<and> (qs!i \<in> {y,x})}. ALG'_det A qs init i y + ALG'_det A qs init i x)
     = (\<Sum>i\<in>{i. i<length qs} \<inter> {i. (qs!i \<in> {y,x})}. ALG'_det A qs init i y + ALG'_det A qs init i x)"
     unfolding e by simp
   also have "\<dots> = (\<Sum>i\<in>{i. i<length qs}. (if i \<in> {i. (qs!i \<in> {y,x})} then ALG'_det A qs init i y + ALG'_det A qs init i x
                                                     else 0))"
     apply(rule sum.inter_restrict) by auto
   also have "\<dots> = (\<Sum>i\<in>{..<length qs}. (if i \<in> {i. (qs!i \<in> {y,x})} then ALG'_det A qs init i y + ALG'_det A qs init i x
                                                     else 0))"
       unfolding f by auto
   also have "\<dots> = ALGxy_det A qs init x y"
     unfolding ALGxy_det_def by auto
   finally show ?thesis by simp
 qed
     
 subsubsection "ALGxy"
 
 definition ALGxy where
   "ALGxy A qs init x y = (\<Sum>i\<in>{..<length qs} \<inter> {i. (qs!i \<in> {y,x})}. ALG' A qs init i y + ALG' A qs init i x)"
 
 lemma ALGxy_def2:
   "ALGxy A qs init x y = (\<Sum>i\<in>{i. i<length qs \<and> (qs!i \<in> {y,x})}. ALG' A qs init i y + ALG' A qs init i x)"
 proof -
   have a: "{i. i<length qs \<and> (qs!i \<in> {y,x})} = {..<length qs} \<inter> {i. (qs!i \<in> {y,x})}" by auto
   show ?thesis unfolding ALGxy_def a by simp
 qed
 lemma ALGxy_append: "ALGxy A (rs@[r]) init x y =
       ALGxy A rs init x y + (if (r \<in> {y,x}) then ALG' A (rs@[r]) init (length rs) y + ALG' A (rs@[r]) init (length rs) x else 0 )" 
 proof -
     have "ALGxy A (rs@[r]) init x y = (\<Sum>i\<in>{..<(Suc (length rs))} \<inter> {i. (rs @ [r]) ! i \<in> {y, x}}.
        ALG' A (rs @ [r]) init i y +
        ALG' A (rs @ [r]) init i x)" unfolding ALGxy_def by(simp)
     also have "\<dots> = (\<Sum>i\<in>{..<(Suc (length rs))}. (if i\<in>{i. (rs @ [r]) ! i \<in> {y, x}} then
        ALG' A (rs @ [r]) init i y +
        ALG' A (rs @ [r]) init i x else 0) )"
        apply(rule sum.inter_restrict) by simp
     also have "\<dots> = (\<Sum>i\<in>{..<length rs}. (if i\<in>{i. (rs @ [r]) ! i \<in> {y, x}} then
        ALG' A (rs @ [r]) init i y +
        ALG' A (rs @ [r]) init i x else 0) ) + (if length rs\<in>{i. (rs @ [r]) ! i \<in> {y, x}} then
        ALG' A (rs @ [r]) init (length rs) y +
        ALG' A (rs @ [r]) init(length rs) x else 0) " by simp
     also have "\<dots> = ALGxy A rs init x y + (if r \<in> {y, x} then
        ALG' A (rs @ [r]) init (length rs) y +
        ALG' A (rs @ [r]) init(length rs) x else 0)" 
             apply(simp add: ALGxy_def sum.inter_restrict nth_append)
             unfolding ALG'_def
               apply(rule sum.cong)
                 apply(simp)  by(auto simp: nth_append)
     finally show ?thesis .
 qed
 
 lemma ALGxy_wholerange: "ALGxy A qs init x y
     = (\<Sum>i<(length qs). (if qs ! i \<in> {y, x}
           then ALG' A qs init i y + ALG' A qs init i x
           else 0 ))"
 proof -
   have "ALGxy A qs init x y
       = (\<Sum>i\<in> {i. i < length qs} \<inter> {i. qs ! i \<in> {y, x}}.
        ALG' A qs init i y + ALG' A qs init i x)"
         unfolding ALGxy_def
         apply(rule sum.cong)
           apply(simp) apply(blast) 
           by simp 
   also have "\<dots> = (\<Sum>i\<in>{i. i < length qs}.  if i \<in> {i. qs ! i \<in> {y, x}}
                                     then ALG' A qs init i y + ALG' A qs init i x 
                                     else 0)"
               by(rule sum.inter_restrict) simp
   also have "\<dots> = (\<Sum>i<(length qs). (if qs ! i \<in> {y, x}
           then ALG' A qs init i y + ALG' A qs init i x
           else 0 ))" apply(rule sum.cong) by(auto)
   finally show ?thesis .
 qed
   
 subsection "Transformation to Blocking Cost"
 
 lemma umformung:
   fixes A :: "(('a::linorder) list,'is,'a,(nat * nat list)) alg_on_rand"
   assumes no_paid: "\<And>is s q. \<forall>((free,paid),_) \<in> (snd A (s,is) q). paid=[]"
   assumes inlist: "set qs \<subseteq> set init"
   assumes dist: "distinct init"
   assumes "\<And>x. x < length qs \<Longrightarrow> finite (set_pmf (config'' A qs init x))"
   shows "T\<^sub>p_on_rand A init qs = 
     (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALGxy A qs init x y)"
 proof -
   have config_dist: "\<forall>n. \<forall>xa \<in> set_pmf (config'' A qs init n). distinct (fst xa)"
       using dist config_rand_distinct by metis
 
   have E0: "T\<^sub>p_on_rand A init qs =
         (\<Sum>i\<in>{..<length qs}. T\<^sub>p_on_rand_n A init qs i)" unfolding T_on_rand_as_sum by auto
   also have "\<dots> = 
   (\<Sum>i<length qs.  E (bind_pmf (config'' A qs init i)
                           (\<lambda>s. bind_pmf (snd A s (qs ! i))
                             (\<lambda>(a, nis). return_pmf (real (\<Sum>x\<in>set init. ALG x qs i s))))))"
     apply(rule sum.cong)
       apply(simp)
       apply(simp add: bind_return_pmf bind_assoc_pmf)
       apply(rule arg_cong[where f=E]) 
           apply(rule bind_pmf_cong)
             apply(simp)
               apply(rule bind_pmf_cong)
                 apply(simp)
                 apply(simp add: split_def)
                   apply(subst t\<^sub>p_sumofALGreal)
                   proof (goal_cases)
                     case 1
                     then show ?case using config_dist by(metis)
                   next
                     case (2 a b c)
                     then show ?case using no_paid[of "fst b" "snd b"] by(auto simp add: split_def)
                   next
                     case (3 a b c)
                     with config_rand_set have a: "set (fst b) = set init" by metis
                     with inlist have " set qs \<subseteq> set (fst b)" by auto
                     with 3 show ?case by auto 
                   next
                     case (4 a b c)
                     with config_rand_set have a: "set (fst b) = set init" by metis
                     then show ?case by(simp) 
                   qed
           
 
           (* hier erst s, dann init *)
    also have "\<dots> = (\<Sum>i<length qs.
                E (map_pmf (\<lambda>(is, s). (real (\<Sum>x\<in>set init. ALG x qs i (is,s))))
                            (config'' A qs init i)))" 
                    apply(simp only: map_pmf_def split_def) by simp 
    also have E1: "\<dots> = (\<Sum>i<length qs. (\<Sum>x\<in>set init. ALG' A qs init i x))"
         apply(rule sum.cong)
           apply(simp) 
             apply(simp add: split_def ALG'_def)
              apply(rule E_linear_sum_allg)
               by(rule assms(4)) 
    also have E2: "\<dots> = (\<Sum>x\<in>set init.
           (\<Sum>i<length qs. ALG' A qs init i x))"
           by(rule sum.swap) (* die summen tauschen *)
    also have E3: "\<dots> = (\<Sum>x\<in>set init.
           (\<Sum>y\<in>set init.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG' A qs init i x)))"
             proof (rule sum.cong, goal_cases)
               case (2 x)
               have "(\<Sum>i<length qs. ALG' A qs init i x)
                 = sum (%i. ALG' A qs init i x) {i. i<length qs}"
                   by (metis lessThan_def)
               also have "\<dots> = sum (%i. ALG' A qs init i x) 
                         (\<Union>y\<in>{y. y \<in> set init}. {i. i < length qs \<and> qs ! i = y})"
                          apply(rule sum.cong)
                           apply(auto)
                          using inlist by auto
               also have "\<dots> = sum (%t. sum (%i. ALG' A qs init i x) {i. i<length qs \<and> qs ! i = t}) {y. y\<in> set init}"
                 apply(rule sum.UNION_disjoint)
                   apply(simp_all) by force
               also have "\<dots> = (\<Sum>y\<in>set init. \<Sum>i | i < length qs \<and> qs ! i = y.
                        ALG' A qs init i x)" by auto                  
              finally show ?case .
             qed (simp)
               
    also have "\<dots> = (\<Sum>(x,y)\<in> (set init \<times> set init).
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG' A qs init i x))"
        by (rule sum.cartesian_product)
    also have "\<dots> = (\<Sum>(x,y)\<in> {(x,y). x\<in>set init \<and> y\<in> set init}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG' A qs init i x))"
             by simp
     also have E4: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x\<in>set init \<and> y\<in> set init \<and> x\<noteq>y}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG' A qs init i x))" (is "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f x y)")
       proof -
         let ?M = "{(x,y). x\<in>set init \<and> y\<in> set init \<and> x=y}"
         have A: "?L = ?R \<union> ?M" by auto
         have B: "{} = ?R \<inter> ?M" by auto
 
         have "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R \<union> ?M. ?f x y)"
           by(simp only: A)
         also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?M. ?f x y)"
             apply(rule sum.union_disjoint)
               apply(rule finite_subset[where B="set init \<times> set init"])
                 apply(auto)
               apply(rule finite_subset[where B="set init \<times> set init"])
                 by(auto)
         also have "(\<Sum>(x,y)\<in> ?M. ?f x y) = 0"
           apply(rule sum.neutral)
             by (auto simp add: ALG'_refl) 
         finally show ?thesis by simp
       qed
 
    also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG' A qs init i x)
            + (\<Sum>i\<in>{i. i<length qs \<and> qs!i=x}. ALG' A qs init i y) )"
             (is "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f x y +  ?f y x)")
               proof -
                 let ?R' = "{(x,y). x \<in> set init \<and> y\<in>set init \<and> y<x}"
                 have A: "?L = ?R \<union> ?R'" by auto
                 have "{} = ?R \<inter> ?R'" by auto
                 have C: "?R' = (%(x,y). (y, x)) ` ?R" by auto
 
                 have D: "(\<Sum>(x,y)\<in> ?R'. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f y x)"
                 proof -
                   have "(\<Sum>(x,y)\<in> ?R'. ?f x y) = (\<Sum>(x,y)\<in> (%(x,y). (y, x)) ` ?R. ?f x y)"
                       by(simp only: C)
                   also have "(\<Sum>z\<in> (%(x,y). (y, x)) ` ?R. (%(x,y). ?f x y) z) = (\<Sum>z\<in>?R. ((%(x,y). ?f x y) \<circ> (%(x,y). (y, x))) z)"
                     apply(rule sum.reindex)
                       by(fact swap_inj_on)
                   also have "\<dots> = (\<Sum>z\<in>?R. (%(x,y). ?f y x) z)"
                     apply(rule sum.cong)
                       by(auto)
                   finally show ?thesis .                  
               qed
 
                 have "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R \<union> ?R'. ?f x y)"
                   by(simp only: A) 
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?R'. ?f x y)"
                   apply(rule sum.union_disjoint) 
                     apply(rule finite_subset[where B="set init \<times> set init"])
                       apply(auto)
                     apply(rule finite_subset[where B="set init \<times> set init"])
                       by(auto)
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?R. ?f y x)"
                     by(simp only: D)                  
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y + ?f y x)"
                   by(simp add: split_def sum.distrib[symmetric])
               finally show ?thesis .
             qed
                 
    also have E5: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
             (\<Sum>i\<in>{i. i<length qs \<and> (qs!i=y \<or> qs!i=x)}. ALG' A qs init i y + ALG' A qs init i x))"
     apply(rule sum.cong)
       apply(simp)
       proof goal_cases
         case (1 x)
         then obtain a b where x: "x=(a,b)" and a: "a \<in> set init" "b \<in> set init" "a < b" by auto
         then have "a\<noteq>b" by simp
         then have disj: "{i. i < length qs \<and> qs ! i = b} \<inter> {i. i < length qs \<and> qs ! i = a} = {}" by auto
         have unio: "{i. i < length qs \<and> (qs ! i = b \<or> qs ! i = a)}
             = {i. i < length qs \<and> qs ! i = b} \<union> {i. i < length qs \<and> qs ! i = a}" by auto
         have "(\<Sum>i\<in>{i. i < length qs \<and> qs ! i = b} \<union>
           {i. i < length qs \<and> qs ! i = a}. ALG' A qs init i b +
                ALG' A qs init i a)
                = (\<Sum>i\<in>{i. i < length qs \<and> qs ! i = b}. ALG' A qs init i b +
                ALG' A qs init i a) + (\<Sum>i\<in>
           {i. i < length qs \<and> qs ! i = a}. ALG' A qs init i b +
                ALG' A qs init i a) - (\<Sum>i\<in>{i. i < length qs \<and> qs ! i = b} \<inter>
           {i. i < length qs \<and> qs ! i = a}. ALG' A qs init i b +
                ALG' A qs init i a) "
                apply(rule sum_Un)
                 by(auto)
         also have "\<dots> = (\<Sum>i\<in>{i. i < length qs \<and> qs ! i = b}. ALG' A qs init i b +
                ALG' A qs init i a) + (\<Sum>i\<in>
           {i. i < length qs \<and> qs ! i = a}. ALG' A qs init i b +
                ALG' A qs init i a)" using disj by auto
         also have "\<dots> = (\<Sum>i\<in>{i. i < length qs \<and> qs ! i = b}. ALG' A qs init i a)
          + (\<Sum>i\<in>{i. i < length qs \<and> qs ! i = a}. ALG' A qs init i b)"
           by (auto simp: ALG'_refl)
         finally 
             show ?case unfolding x apply(simp add: split_def)
           unfolding unio by simp
      qed   
      also have E6: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                   ALGxy A qs init x y)"
            unfolding ALGxy_def2 by simp
      finally show ?thesis . 
 qed (* this is lemma 1.4 *)
 
 
 lemma before_in_index1:
   fixes l
   assumes "set l = {x,y}" and "length l = 2" and "x\<noteq>y"
   shows "(if (x < y in l) then 0 else 1) = index l x"
 unfolding before_in_def
 proof (auto, goal_cases) (* bad style! *)
   case 1
   from assms(1) have "index l y < length l" by simp
   with assms(2) 1(1) show "index l x = 0" by auto
 next
   case 2
   from assms(1) have a: "index l x < length l" by simp
   from assms(1,3) have "index l y \<noteq> index l x" by simp
   with assms(2) 2(1) a show "Suc 0 = index l x" by simp
 qed (simp add: assms)
 
 
 lemma before_in_index2:
   fixes l
   assumes "set l = {x,y}" and "length l = 2" and "x\<noteq>y"
   shows "(if (x < y in l) then 1 else 0) = index l y"
 unfolding before_in_def
 proof (auto, goal_cases) (* bad style! *)
   case 2
   from assms(1,3) have a: "index l y \<noteq> index l x" by simp
   from assms(1) have "index l x < length l" by simp
   with assms(2) a 2(1) show "index l y = 0" by auto
 next
   case 1
   from assms(1) have a: "index l y < length l" by simp
   from assms(1,3) have "index l y \<noteq> index l x" by simp
   with assms(2) 1(1) a show "Suc 0 = index l y" by simp
 qed (simp add: assms)
 
 
 lemma before_in_index:
   fixes l
   assumes "set l = {x,y}" and "length l = 2" and "x\<noteq>y"
   shows "(x < y in l) = (index l x = 0)"
 unfolding before_in_def
 proof (safe, goal_cases)
   case 1
   from assms(1) have "index l y < length l" by simp
   with assms(2) 1(1) show "index l x = 0" by auto
 next
   case 2
   from assms(1,3) have "index l y \<noteq> index l x" by simp
   with 2(1) show "index l x < index l y" by simp
 qed (simp add: assms)
 
 
 subsection "The pairwise property"
 
 
 definition pairwise where
   "pairwise A = (\<forall>init. distinct init \<longrightarrow> (\<forall>qs\<in>{xs. set xs \<subseteq> set init}. \<forall>(x::('a::linorder),y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. T\<^sub>p_on_rand A (Lxy init {x,y}) (Lxy qs {x,y}) = ALGxy A qs init x y))"
   
 definition "Pbefore_in x y A qs init = map_pmf (\<lambda>p. x < y in fst p) (config_rand A init qs)"
  
 
 lemma T_on_n_no_paid:
       assumes 
       nopaid: "\<And>s n. map_pmf (\<lambda>x. snd (fst x)) (snd A s n) = return_pmf []" 
       shows "T_on_rand_n A init qs i = E (config'' A qs init i \<bind> (\<lambda>p. return_pmf (real(index (fst p) (qs ! i)))))"
 proof - 
 
   have "(\<lambda>s. snd A s (qs ! i) \<bind>
             (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst s) (qs ! i) a))))
        =
         (\<lambda>s. (snd A s (qs ! i) \<bind> (\<lambda>x. return_pmf (snd (fst x))))
               \<bind> (\<lambda>p. return_pmf
                (real (index (swaps p (fst s)) (qs ! i)) +
                 real (length p))))"
             by(simp add: t\<^sub>p_def split_def bind_return_pmf bind_assoc_pmf)
 also
   have "\<dots> = (\<lambda>p. return_pmf (real (index (fst p) (qs ! i))))"
     using nopaid[unfolded map_pmf_def]
     by(simp add: split_def bind_return_pmf)
 finally
   show ?thesis by simp
 qed
  
 lemma pairwise_property_lemma:
   assumes  
 relativeorder: "(\<And>init qs. distinct init \<Longrightarrow> qs \<in> {xs. set xs \<subseteq> set init}
     \<Longrightarrow> (\<And>x y. (x,y)\<in> {(x,y). x \<in> set init \<and> y\<in>set init \<and> x\<noteq>y} 
                 \<Longrightarrow> x \<noteq> y
                 \<Longrightarrow> Pbefore_in x y A qs init = Pbefore_in x y A (Lxy qs {x,y}) (Lxy init {x,y})
         ))" 
 and nopaid: "\<And>xa r. \<forall>z\<in> set_pmf(snd A xa r). snd(fst z) = []"
 shows "pairwise A"
 unfolding pairwise_def
 proof (clarify, goal_cases)
   case (1 init rs x y)
   then have xny: "x\<noteq>y" by auto
 
   note dinit=1(1)
   then have dLyx: "distinct (Lxy init {y,x})" by(rule Lxy_distinct)
   from dinit have dLxy: "distinct (Lxy init {x,y})" by(rule Lxy_distinct)
   have setLxy: "set (Lxy init {x, y}) = {x,y}" apply(subst Lxy_set_filter) using 1 by auto
   have setLyx: "set (Lxy init {y, x}) = {x,y}" apply(subst Lxy_set_filter) using 1 by auto
   have lengthLyx:" length  (Lxy init {y, x}) = 2" using setLyx distinct_card[OF dLyx] xny by simp
   have lengthLxy:" length  (Lxy init {x, y}) = 2" using setLxy distinct_card[OF dLxy] xny by simp
   have aee: "{x,y} = {y,x}" by auto
 
 
   from 1(2) show ?case
     proof(induct rs rule: rev_induct)
       case (snoc r rs)
       
       have b: "Pbefore_in x y A rs init = Pbefore_in x y A (Lxy rs {x,y}) (Lxy init {x,y})"
         apply(rule relativeorder)
         using snoc 1 xny by(simp_all)  
 
       show ?case (is "?L (rs @ [r]) = ?R (rs @ [r])")
       proof(cases "r\<in>{x,y}")
         case True
         note xyrequest=this
         let ?expr = "E (Partial_Cost_Model.config'_rand A
         (fst A (Lxy init {x, y}) \<bind>
          (\<lambda>is. return_pmf (Lxy init {x, y}, is)))
         (Lxy rs {x, y}) \<bind>
        (\<lambda>s. snd A s r \<bind>
             (\<lambda>(a, is').
                 return_pmf
                  (real (t\<^sub>p (fst s) r a)))))"
         let ?expr2 = "ALG' A (rs @ [r]) init (length rs) y + ALG' A (rs @ [r]) init (length rs) x"
 
         from xyrequest have "?L (rs @ [r]) = ?L rs + ?expr"
           by(simp add: Lxy_snoc T_on_rand'_append)
         also have "\<dots> = ?L rs + ?expr2"
           proof(cases "r=x") 
             case True
             let ?projS ="config'_rand A (fst A (Lxy init {x, y}) \<bind> (\<lambda>is. return_pmf (Lxy init {x, y}, is))) (Lxy rs {x, y})"
             let ?S = "(config'_rand A (fst A init \<bind> (\<lambda>is. return_pmf (init, is))) rs)"
 
 
             have "?projS \<bind> (\<lambda>s. snd A s r
                            \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst s) r a))))
               = ?projS \<bind> (\<lambda>s. return_pmf (real (index (fst s) r)))"
                     proof (rule bind_pmf_cong, goal_cases)
                       case (2 z)
                       have "snd A z r \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst z) r a))) = snd A z r \<bind> (\<lambda>x. return_pmf (real (index (fst z) r)))"  
                         apply(rule bind_pmf_cong)
                           apply(simp)
                           using nopaid[of z r] by(simp add: split_def t\<^sub>p_def) 
                       then show ?case by(simp add: bind_return_pmf)
                     qed simp
             also have "\<dots> = map_pmf (%b. (if b then 0::real else 1)) (Pbefore_in x y A (Lxy rs {x,y}) (Lxy init {x,y}))"
                   unfolding Pbefore_in_def map_pmf_def
                     apply(simp add: bind_return_pmf bind_assoc_pmf)
                     apply(rule bind_pmf_cong)
                       apply(simp add: aee)
                       proof goal_cases
                         case (1 z)
                         have " (if x < y in fst z then 0 else 1) = (index (fst z) x)"
                             apply(rule before_in_index1)
                               using 1 config_rand_set setLxy apply fast
                               using 1 config_rand_length lengthLxy apply metis                 
                               using xny by simp
                         with True show ?case
                           by(auto)
                       qed
             also have "\<dots> = map_pmf (%b. (if b then 0::real else 1)) (Pbefore_in x y A rs init)" by(simp add: b)
                       
             also have "\<dots> = map_pmf (\<lambda>xa. real (if y < x in fst xa then 1 else 0)) ?S"  
                 apply(simp add: Pbefore_in_def map_pmf_comp)
                 proof (rule map_pmf_cong, goal_cases)
                   case (2 z)
                   then have set_z: "set (fst z) = set init"
                     using config_rand_set by fast
                   have "(\<not> x < y in fst z) = y < x in fst z" 
                     apply(subst not_before_in)
                       using set_z 1(3,4) xny by(simp_all)
-                  then show ?case bysimp
+                  then show ?case by simp
                 qed simp 
             finally have a: "?projS \<bind> (\<lambda>s. snd A s x
                            \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst s) x a))))
                   = map_pmf (\<lambda>xa. real (if y < x in fst xa then 1 else 0)) ?S" using True by simp
             from True show ?thesis
             apply(simp add: ALG'_refl nth_append)
             unfolding ALG'_def
               by(simp add: a)
           next
             case False
             with xyrequest have request: "r=y" by blast
 
             let ?projS ="config'_rand A (fst A (Lxy init {x, y}) \<bind> (\<lambda>is. return_pmf (Lxy init {x, y}, is))) (Lxy rs {x, y})"
             let ?S = "(config'_rand A (fst A init \<bind> (\<lambda>is. return_pmf (init, is))) rs)"
 
 
             have "?projS \<bind> (\<lambda>s. snd A s r
                            \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst s) r a))))
               = ?projS \<bind> (\<lambda>s. return_pmf (real (index (fst s) r)))"
                     proof (rule bind_pmf_cong, goal_cases)
                       case (2 z)
                       have "snd A z r \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst z) r a))) = snd A z r \<bind> (\<lambda>x. return_pmf (real (index (fst z) r)))"  
                         apply(rule bind_pmf_cong)
                           apply(simp)
                           using nopaid[of z r] by(simp add: split_def t\<^sub>p_def) 
                       then show ?case by(simp add: bind_return_pmf)
                     qed simp
             also have "\<dots> = map_pmf (%b. (if b then 1::real else 0)) (Pbefore_in x y A (Lxy rs {x,y}) (Lxy init {x,y}))"
                   unfolding Pbefore_in_def map_pmf_def
                     apply(simp add: bind_return_pmf bind_assoc_pmf)
                     apply(rule bind_pmf_cong)
                       apply(simp add: aee)
                       proof goal_cases
                         case (1 z)
                         have " (if x < y in fst z then 1 else 0) = (index (fst z) y)"
                             apply(rule before_in_index2)
                               using 1 config_rand_set setLxy apply fast
                               using 1 config_rand_length lengthLxy apply metis                 
                               using xny by simp
                         with request show ?case
                           by(auto)
                       qed
             also have "\<dots> = map_pmf (%b. (if b then 1::real else 0)) (Pbefore_in x y A rs init)" by(simp add: b)
                       
             also have "\<dots> = map_pmf (\<lambda>xa. real (if x < y in fst xa then 1 else 0)) ?S"  
                 apply(simp add: Pbefore_in_def map_pmf_comp)
                 apply (rule map_pmf_cong) by simp_all 
             finally have a: "?projS \<bind> (\<lambda>s. snd A s y
                            \<bind> (\<lambda>(a, is'). return_pmf (real (t\<^sub>p (fst s) y a))))
                   = map_pmf (\<lambda>xa. real (if x < y in fst xa then 1 else 0)) ?S" using request by simp
             from request show ?thesis
             apply(simp add: ALG'_refl nth_append)
             unfolding ALG'_def
               by(simp add: a) 
           qed            
         also have "\<dots> = ?R rs + ?expr2" using snoc by simp 
         also from True have "\<dots> = ?R (rs@[r])"
             apply(subst ALGxy_append) by(auto)
         finally show ?thesis .
       next
         case False
         then have "?L (rs @ [r]) = ?L rs" apply(subst Lxy_snoc) by simp
         also have "\<dots> = ?R rs" using snoc by(simp)
         also have "\<dots> = ?R (rs @ [r])"  
             apply(subst ALGxy_append) using False by(simp)
         finally show ?thesis .
       qed
     qed (simp add: ALGxy_def)
 qed
 
 
 lemma umf_pair: assumes
    0: "pairwise A"
   assumes 1: "\<And>is s q. \<forall>((free,paid),_) \<in> (snd A (s, is) q). paid=[]"
   assumes 2: "set qs \<subseteq> set init"
   assumes 3: "distinct init"
   assumes 4: "\<And>x. x<length qs \<Longrightarrow> finite (set_pmf (config'' A qs init x))"
    shows "T\<^sub>p_on_rand A init qs
       = (\<Sum>(x,y)\<in>{(x, y). x \<in> set init \<and> y \<in> set init \<and> x < y}. T\<^sub>p_on_rand A (Lxy init {x,y}) (Lxy qs {x,y}))"
 proof -
   have " T\<^sub>p_on_rand A init qs = (\<Sum>(x,y)\<in>{(x, y). x \<in> set init \<and> y \<in> set init \<and> x < y}. ALGxy A qs init x y)"
     by(simp only: umformung[OF 1 2 3 4])
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x, y). x \<in> set init \<and> y \<in> set init \<and> x < y}. T\<^sub>p_on_rand A (Lxy init {x,y}) (Lxy qs {x,y}))"
     apply(rule sum.cong)
       apply(simp)
       using 0[unfolded pairwise_def] 2 3 by auto
   finally show ?thesis .
 qed
  
 subsection "List Factoring for OPT"
 
 (* calculates given a list of swaps, elements x and y and a current state
   how many swaps between x and y there are *)
 fun ALG_P :: "nat list \<Rightarrow> 'a  \<Rightarrow> 'a  \<Rightarrow> 'a list \<Rightarrow> nat" where
   "ALG_P [] x y xs = (0::nat)"
 | "ALG_P (s#ss) x y xs = (if Suc s < length (swaps ss xs)
                           then (if ((swaps ss xs)!s=x \<and> (swaps ss xs)!(Suc s)=y) \<or> ((swaps ss xs)!s=y \<and> (swaps ss xs)!(Suc s)=x)
                                 then 1
                                 else 0)
                           else 0) + ALG_P ss x y xs"
 
 (* nat list ersetzen durch (a::ordered) list *)
 lemma ALG_P_erwischt_alle:
   assumes dinit: "distinct init" 
   shows
   "\<forall>l< length sws. Suc (sws!l) < length init \<Longrightarrow> length sws
         = (\<Sum>(x,y)\<in>{(x,y). x \<in> set (init::('a::linorder) list) \<and> y\<in>set init \<and> x<y}. ALG_P sws x y init)"
 proof (induct sws)
   case (Cons s ss)
   then have isininit: "Suc s < length init" by auto
   from Cons have "\<forall>l<length ss. Suc (ss ! l)  < length init" by auto
   note iH=Cons(1)[OF this]
   
   let ?expr = "(\<lambda>x y. (if Suc s < length (swaps ss init)
                           then (if ((swaps ss init)!s=x \<and> (swaps ss init)!(Suc s)=y) \<or> ((swaps ss init)!s=y \<and> (swaps ss init)!(Suc s)=x)
                                 then 1::nat
                                 else 0)
                           else 0))"
 
   let ?expr2 = "(\<lambda>x y. (if ((swaps ss init)!s=x \<and> (swaps ss init)!(Suc s)=y) \<or> ((swaps ss init)!s=y \<and> (swaps ss init)!(Suc s)=x)
                                 then 1
                                 else 0))"
 
   let ?expr3 = "(%x y.  ((swaps ss init)!s=x \<and> (swaps ss init)!(Suc s)=y)
                     \<or> ((swaps ss init)!s=y \<and> (swaps ss init)!(Suc s)=x))"
   let ?co' = "swaps ss init"
 
   from dinit have dco: "distinct ?co'" by auto
 
   let ?expr4 = "(\<lambda>z. (if z\<in>{(x,y). ?expr3 x y}
                                 then 1
                                 else 0))"
 
   have scoinit: "set ?co' = set init" by auto
   from isininit have isT: "Suc s < length ?co'" by auto
   then have isT2: "Suc s < length init" by auto
   then have isT3: "s < length init" by auto
   then have isT6: "s < length ?co'" by auto
   from isT2 have isT7: "Suc s < length ?co'" by auto
   from isT6 have a: "?co'!s \<in> set ?co'" by (rule nth_mem)
   then have a: "?co'!s \<in> set init" by auto
   from isT7 have "?co'! (Suc s) \<in> set ?co'" by (rule nth_mem)
   then have b: "?co'!(Suc s) \<in> set init" by auto
 
   have  "{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}
                           \<inter> {(x,y). ?expr3 x y}
      = {(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y
                               \<and>  (?co'!s=x \<and> ?co'!(Suc s)=y
                                   \<or> ?co'!s=y \<and> ?co'!(Suc s)=x)}" by auto
   also have "\<dots> = {(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y
                               \<and>  ?co'!s=x \<and> ?co'!(Suc s)=y }
                            \<union>
                   {(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y
                               \<and>   ?co'!s=y \<and> ?co'!(Suc s)=x}" by auto
   also have "\<dots> = {(x,y). x<y \<and> ?co'!s=x \<and> ?co'!(Suc s)=y}
                            \<union>
                   {(x,y). x<y \<and> ?co'!s=y \<and> ?co'!(Suc s)=x}"
               using a b by(auto)
   finally have c1: "{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y} \<inter> {(x,y). ?expr3 x y}
       = {(x,y). x<y \<and> ?co'!s=x \<and> ?co'!(Suc s)=y}
                            \<union>
                   {(x,y). x<y \<and> ?co'!s=y \<and> ?co'!(Suc s)=x}" . 
 
   have c2: "card ({(x,y). x<y \<and> ?co'!s=x \<and> ?co'!(Suc s)=y}
                            \<union>
                   {(x,y). x<y \<and> ?co'!s=y \<and> ?co'!(Suc s)=x}) = 1" (is "card (?A \<union> ?B) = 1")
   proof (cases "?co'!s<?co'!(Suc s)")
     case True
     then have a: "?A = { (?co'!s, ?co'!(Suc s)) }"
           and b: "?B = {} " by auto
     have c: "?A \<union> ?B = { (?co'!s, ?co'!(Suc s)) }" apply(simp only: a b) by simp 
     have "card (?A \<union> ?B) = 1" unfolding c by auto
     then show ?thesis .
   next
     case False
     then have a: "?A = {}" by auto
     have b: "?B = { (?co'!(Suc s), ?co'!s) } "
     proof -
      from dco distinct_conv_nth[of "?co'"] 
      have "swaps ss init ! s \<noteq> swaps ss init ! (Suc s)" 
       using isT2 isT3 by simp
      with False show ?thesis by auto
     qed
 
     have c: "?A \<union> ?B = { (?co'!(Suc s), ?co'!s) }" apply(simp only: a b) by simp 
     have "card (?A \<union> ?B) = 1" unfolding c by auto
     then show ?thesis .
   qed
     
         
 
   have yeah: "(\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr x y) = (1::nat)"
   proof -
     have "(\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr x y)
         = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr2 x y)"
           using isT by auto
     also have "\<dots> = (\<Sum>z\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr2 (fst z) (snd z))"
         by(simp add: split_def)
     also have "\<dots> = (\<Sum>z\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr4 z)"
         by(simp add: split_def)
     also have "\<dots> = (\<Sum>z\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}
                           \<inter>{(x,y). ?expr3 x y} . 1)"
         apply(rule sum.inter_restrict[symmetric])
               apply(rule finite_subset[where B="set init \<times> set init"])
                 by(auto)
     also have "\<dots> = card ({(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}
                           \<inter> {(x,y). ?expr3 x y})" by auto
     also have "\<dots> = card ({(x,y). x<y \<and> ?co'!s=x \<and> ?co'!(Suc s)=y}
                            \<union>
                   {(x,y). x<y \<and> ?co'!s=y \<and> ?co'!(Suc s)=x})" by(simp only: c1)
     also have "\<dots> = (1::nat)" using c2 by auto
     finally show ?thesis .
   qed
 
   have "length (s # ss) = 1 + length ss"
     by auto
   also have "\<dots> = 1 + (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P ss x y init)"
     using iH by auto
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr x y)
             + (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P ss x y init)"
     by(simp only: yeah)
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ?expr x y + ALG_P ss x y init)"
     (is "?A + ?B = ?C") 
     by (simp add: sum.distrib split_def)  
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (s#ss) x y init)"
     by auto
   finally show ?case . 
 qed (simp)
 
 
 
 
 (* thesame with paid exchanges *) 
 lemma t\<^sub>p_sumofALGALGP:
 assumes "distinct s" "(qs!i)\<in>set s"
   and "\<forall>l< length (snd a). Suc ((snd a)!l) < length s"
 shows "t\<^sub>p s (qs!i) a = (\<Sum>e\<in>set s. ALG e qs i (swaps (snd a) s,())) 
       + (\<Sum>(x,y)\<in>{(x::('a::linorder),y). x \<in> set s \<and> y\<in>set s \<and> x<y}. ALG_P (snd a) x y s)"
 proof -
   (* paid exchanges *)
   have pe: "length (snd a)
         = (\<Sum>(x,y)\<in>{(x,y). x \<in> set s \<and> y\<in>set s \<and> x<y}. ALG_P (snd a) x y s)"   
     apply(rule ALG_P_erwischt_alle)  
         by(fact)+                                              
 
   (* access cost *)
   have ac: "index (swaps (snd a) s) (qs ! i) = (\<Sum>e\<in>set s. ALG e qs i (swaps (snd a) s,()))"
   proof -
     have "index (swaps (snd a) s) (qs ! i) 
         = (\<Sum>e\<in>set (swaps (snd a) s). if e < (qs ! i) in (swaps (snd a) s) then 1 else 0)" 
           apply(rule index_sum)
             using assms by(simp_all)
     also have "\<dots> = (\<Sum>e\<in>set s. ALG e qs i (swaps (snd a) s,()))" by auto
     finally show ?thesis .
   qed
 
   show ?thesis
     unfolding t\<^sub>p_def apply (simp add: split_def)
     unfolding ac pe by (simp add: split_def)
 qed
 
 
 (* given a Strategy Strat to serve request sequence qs on initial list init how many
   swaps between elements x and y occur during the ith step *)
 definition "ALG_P' Strat qs init i x y = ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)"
 
 (* if n is in bound, Strat may be too long, that does not matter *)
 lemma ALG_P'_rest: "n < length qs \<Longrightarrow> n < length Strat \<Longrightarrow> 
   ALG_P' Strat (take n qs @ [qs ! n]) init n x y =
     ALG_P' (take n Strat @ [Strat ! n]) (take n qs @ [qs ! n]) init n x y"
 proof -
   assume qs: "n < length qs"
   assume S: "n < length Strat"
 
   then have lS: "length (take n Strat) = n" by auto
   have "(take n Strat @ [Strat ! n]) ! n =
       (take n Strat @ (Strat ! n) # []) ! length (take n Strat)" using lS by auto
   also have "\<dots> = Strat ! n" by(rule nth_append_length)
   finally have tt: "(take n Strat @ [Strat ! n]) ! n = Strat ! n" .
 
   obtain rest where rest: "Strat = (take n Strat @ [Strat ! n] @ rest)" 
         using S apply(auto) using id_take_nth_drop by blast
 
   have "steps' init (take n qs @ [qs ! n])
        (take n Strat @ [Strat ! n]) n
       = steps' init (take n qs)
        (take n Strat) n"
        apply(rule steps'_rests[symmetric])
         using S qs by auto
   also have "\<dots> = 
       steps' init (take n qs @ [qs ! n])
        (take n Strat @ ([Strat ! n] @ rest)) n"
        apply(rule steps'_rests)
         using S qs by auto
   finally show ?thesis unfolding ALG_P'_def tt using rest by auto
 qed
 
 (* verallgemeinert ALG_P'_rest, sollte mergen! *)
 lemma ALG_P'_rest2: "n < length qs \<Longrightarrow> n < length Strat \<Longrightarrow> 
   ALG_P' Strat qs init n x y =
     ALG_P' (Strat@r1) (qs@r2) init n x y"
 proof -
   assume qs: "n < length qs"
   assume S: "n < length Strat"
 
   have tt: "Strat ! n = (Strat @ r1) ! n"
     using S by (simp add: nth_append)
 
   have "steps' init (take n qs) (take n Strat) n = steps' init ((take n qs) @ drop n qs) ((take n Strat) @ (drop n Strat)) n"
        apply(rule steps'_rests)
         using S qs by auto
   then have A: "steps' init (take n qs) (take n Strat) n = steps' init qs Strat n" by auto
   have "steps' init (take n qs) (take n Strat) n = steps' init ((take n qs) @ ((drop n qs)@r2)) ((take n Strat) @((drop n Strat)@r1)) n"
        apply(rule steps'_rests)
         using S qs by auto
   then have B: "steps' init (take n qs) (take n Strat) n = steps' init (qs@r2) (Strat@r1) n"
     by (metis append_assoc List.append_take_drop_id)
   from A B have C: "steps' init qs Strat n = steps' init (qs@r2) (Strat@r1) n" by auto
   show ?thesis unfolding ALG_P'_def tt using C by auto
 
 qed
 
 
 
 (* total number of swaps of elements x and y during execution of Strategy Strat *)
 definition ALG_Pxy  where
   "ALG_Pxy Strat qs init x y = (\<Sum>i<length qs. ALG_P' Strat qs init i x y)"
 
 lemma wegdamit: "length A < length Strat \<Longrightarrow> b \<notin> {x,y} \<Longrightarrow> ALGxy_det Strat (A @ [b]) init x y
     = ALGxy_det Strat A init x y" 
 proof -
   assume bn: "b \<notin> {x,y}"
   have "(A @ [b]) ! (length A) = b" by auto
   assume l: "length A < length Strat"
 
   term "%i. ALG'_det Strat (A @ [b]) init i y"
 
   have e: "\<And>i. i<length A \<Longrightarrow> (A @ [b]) ! i = A ! i" by(auto simp: nth_append)
  have "(\<Sum>i\<in> {..< length (A @ [b])}.
         if (A @ [b]) ! i \<in> {y, x}
         then ALG'_det Strat (A @ [b]) init i y +
              ALG'_det Strat (A @ [b]) init i x
         else 0) = (\<Sum>i\<in> {..< Suc(length (A))}.
         if (A @ [b]) ! i \<in> {y, x}
         then ALG'_det Strat (A @ [b]) init i y +
              ALG'_det Strat (A @ [b]) init i x
         else 0)" by auto 
   also have "\<dots> = (\<Sum>i\<in> {..< (length (A))}.
         if (A @ [b]) ! i \<in> {y, x}
         then ALG'_det Strat (A @ [b]) init i y +
              ALG'_det Strat (A @ [b]) init i x
         else 0) + ( if (A @ [b]) ! (length A) \<in> {y, x}
         then ALG'_det Strat (A @ [b]) init (length A) y +
              ALG'_det Strat (A @ [b]) init (length A) x
         else 0) " by simp (* abspalten des letzten glieds *)
         also have "\<dots> = (\<Sum>i\<in> {..< (length (A))}.
         if (A @ [b]) ! i \<in> {y, x}
         then ALG'_det Strat (A @ [b]) init i y +
              ALG'_det Strat (A @ [b]) init i x
         else 0)" using bn by auto
         also have "\<dots> = (\<Sum>i\<in> {..< (length (A))}.
           if A ! i \<in> {y, x}
           then ALG'_det Strat A init i y +
               ALG'_det Strat A init i x
               else 0)"
             apply(rule sum.cong)
               apply(simp)
               using l ALG'_det_append[where qs=A] e by(simp)
      finally show ?thesis unfolding ALGxy_det_def by simp
 qed
 
 lemma ALG_P_split: "length qs < length Strat \<Longrightarrow> ALG_Pxy Strat (qs@[q]) init x y = ALG_Pxy Strat qs init x y
             +  ALG_P' Strat (qs@[q]) init (length qs) x y "
 unfolding ALG_Pxy_def apply(auto)
   apply(rule sum.cong)
     apply(simp)
     using ALG_P'_rest2[symmetric, of _ qs Strat "[]" "[q]"] by(simp)
     
 
 lemma swap0in2:  assumes "set l = {x,y}" "x\<noteq>y" "length l = 2" "dist_perm l l"
   shows
     "x < y in (swap 0) l = (~ x < y in l)"
 proof (cases "x < y in l")
   case True
   then have a: "index l x < index l y" unfolding before_in_def by simp
   from assms(1) have drin: "x\<in>set l" "y\<in>set l" by auto
   from assms(1,3) have b: "index l y < 2" by simp
   from a b have k: "index l x = 0" "index l y = 1" by auto 
 
   have g: "x = l ! 0" "y = l ! 1"
     using k nth_index assms(1) by force+ 
 
       have "x < y in swap 0 l
       = (x < y in l \<and> \<not> (x = l ! 0 \<and> y = l ! Suc 0)
             \<or>  x = l ! Suc 0 \<and> y = l ! 0)"
             apply(rule before_in_swap)
               apply(fact assms(4))
               using assms(3) by simp
   also have "\<dots> = (\<not> (x = l ! 0 \<and> y = l ! Suc 0)
             \<or>  x = l ! Suc 0 \<and> y = l ! 0)" using True by simp
   also have "\<dots> = False" using g assms(2) by auto
   finally have "~ x < y in (swap 0) l" by simp
   then show ?thesis using True by auto
 next
   case False
   from assms(1,2) have "index l y \<noteq> index l x" by simp
   with False assms(1,2) have a: "index l y < index l x"
     by (metis before_in_def insert_iff linorder_neqE_nat)
   from assms(1) have drin: "x\<in>set l" "y\<in>set l" by auto
   from assms(1,3) have b: "index l x < 2" by simp
   from a b have k: "index l x = 1" "index l y = 0" by auto
   then have g: "x = l ! 1" "y = l ! 0" 
     using k nth_index assms(1) by force+ 
   have "x < y in swap 0 l
       = (x < y in l \<and> \<not> (x = l ! 0 \<and> y = l ! Suc 0)
             \<or>  x = l ! Suc 0 \<and> y = l ! 0)"
             apply(rule before_in_swap)
               apply(fact assms(4))
               using assms(3) by simp
   also have "\<dots> = (x = l ! Suc 0 \<and> y = l ! 0)" using False by simp
   also have "\<dots> = True" using g by auto
   finally have "x < y in (swap 0) l" by simp
   then show ?thesis using False by auto
 qed 
 
 
 
 lemma before_in_swap2:
  "dist_perm xs ys \<Longrightarrow> Suc n < size xs \<Longrightarrow> x\<noteq>y \<Longrightarrow>
   x < y in (swap n xs) \<longleftrightarrow>
   (~ x < y in xs \<and> (y = xs!n \<and> x = xs!Suc n)
       \<or> x < y in xs \<and> ~(y = xs!Suc n \<and> x = xs!n))"
 apply(simp add:before_in_def index_swap_distinct)
 by (metis Suc_lessD Suc_lessI index_nth_id less_Suc_eq nth_mem yes)
 
 lemma projected_paid_same_effect: 
   assumes
    d: "dist_perm s1 s1"  
   and ee: "x\<noteq>y"  
   and f: "set s2 = {x, y}"  
   and g: "length s2 = 2"  
   and h: "dist_perm s2 s2"  
   shows "x < y in s1 = x < y in s2 \<Longrightarrow>
   x < y in swaps acs s1 = x < y in (swap 0 ^^ ALG_P acs x y s1) s2"
 proof (induct acs)
   case Nil
   then show ?case by auto
 next
   case (Cons s ss)
   from d have dd: "dist_perm (swaps ss s1) (swaps ss s1)" by simp
   from f have ff: "set ((swap 0 ^^ ALG_P ss x y s1) s2) = {x, y}" by (metis foldr_replicate swaps_inv)
   from g have gg: "length ((swap 0 ^^ ALG_P ss x y s1) s2) = 2"  by (metis foldr_replicate swaps_inv)
   from h have hh: "dist_perm ((swap 0 ^^ ALG_P ss x y s1) s2) ((swap 0 ^^ ALG_P ss x y s1) s2)" by (metis foldr_replicate swaps_inv) 
   show ?case (is "?LHS = ?RHS")
   proof (cases "Suc s < length (swaps ss s1) \<and> (((swaps ss s1)!s=x \<and> (swaps ss s1)!(Suc s)=y) \<or> ((swaps ss s1)!s=y \<and> (swaps ss s1)!(Suc s)=x))")
     case True
     from True have 1:" Suc s < length (swaps ss s1)"
           and 2: "(swaps ss s1 ! s = x \<and> swaps ss s1 ! Suc s = y
             \<or>  swaps ss s1 ! s = y \<and> swaps ss s1 ! Suc s = x)" by auto
     from True have "ALG_P (s # ss) x y s1 =  1 + ALG_P ss x y s1" by auto
     then have "?RHS = x < y in (swap 0) ((swap 0 ^^ ALG_P ss x y s1) s2)"
       by auto
     also have "\<dots> = (~ x < y in ((swap 0 ^^ ALG_P ss x y s1) s2))" 
       apply(rule swap0in2)
         by(fact)+
     also have "\<dots> = (~ x < y in swaps ss s1)" 
       using Cons by auto
     also have "\<dots> = x < y in (swap s) (swaps ss s1)"
       using 1  2 before_in_swap
       by (metis Suc_lessD before_id dd lessI no_before_inI) (* bad *)
     also have "\<dots> = ?LHS" by auto
     finally show ?thesis by simp
   next
     case False
     note F=this
     then have "ALG_P (s # ss) x y s1 =  ALG_P ss x y s1" by auto
     then have "?RHS = x < y in ((swap 0 ^^ ALG_P ss x y s1) s2)"
       by auto
     also have "\<dots> = x < y in swaps ss s1" 
       using Cons by auto
     also have "\<dots> = x < y in (swap s) (swaps ss s1)"
     proof (cases "Suc s < length (swaps ss s1)")
       case True
       with F have g: "swaps ss s1 ! s \<noteq> x \<or>
          swaps ss s1 ! Suc s \<noteq> y" and
         h: "swaps ss s1 ! s \<noteq> y \<or>
          swaps ss s1 ! Suc s \<noteq> x" by auto 
          show ?thesis 
           unfolding before_in_swap[OF dd True, of x y] apply(simp)
             using g h by auto
     next
       case False
       then show ?thesis unfolding swap_def by(simp)
     qed
     also have "\<dots> = ?LHS" by auto
     finally show ?thesis by simp
   qed
 qed 
   
 
 lemma steps_steps':
   "length qs = length as \<Longrightarrow> steps s qs as = steps' s qs as (length as)"
 by (induct qs as arbitrary: s rule: list_induct2) (auto)
 
 
 lemma T1_7': "T\<^sub>p init qs Strat = T\<^sub>p_opt init qs \<Longrightarrow> length Strat = length qs
       \<Longrightarrow> n\<le>length qs \<Longrightarrow>  
       x\<noteq>(y::('a::linorder)) \<Longrightarrow>
       x\<in> set init \<Longrightarrow> y \<in> set init \<Longrightarrow> distinct init \<Longrightarrow>
       set qs \<subseteq> set init \<Longrightarrow>
       (\<exists>Strat2 sws. 
         \<^cancel>\<open>T\<^sub>p_opt (Lxy init {x,y}) (Lxy (take n qs) {x,y}) \<le> T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x,y}) Strat2
           \<and>\<close>  length Strat2 = length (Lxy (take n qs) {x,y})
           \<and>     (x < y in (steps' init (take n qs) (take n Strat) n))
               = (x < y in (swaps sws (steps' (Lxy init {x,y}) (Lxy (take n qs) {x,y}) Strat2 (length Strat2))))
           \<and> T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x,y}) Strat2 + length sws =            
           ALGxy_det Strat (take n qs) init x y + ALG_Pxy Strat (take n qs) init x y)"
 proof(induct n)
   case (Suc n)
   from Suc(3,4) have ns: "n < length qs" by simp
   then have n: "n \<le> length qs" by simp
   from Suc(1)[OF Suc(2) Suc(3) n Suc(5) Suc(6) Suc(7) Suc(8) Suc(9) ] obtain Strat2 sws where 
   (*S2: "T\<^sub>p_opt (Lxy init {x,y}) (Lxy (take n qs) {x, y})
      \<le> T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2"
      and *) len: "length Strat2 = length (Lxy (take n qs) {x, y})"
      and iff:
       "x < y in steps' init (take n qs) (take n Strat) n
          =
        x < y in swaps sws (steps' (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2 (length Strat2))"   
 
      and T_Strat2: "T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2 + length sws =
      ALGxy_det Strat (take n qs) init x y +
      ALG_Pxy Strat (take n qs) init x y "  by (auto) 
      
   from Suc(3-4) have nStrat: "n < length Strat" by auto 
   from take_Suc_conv_app_nth[OF this] have tak2: "take (Suc n) Strat = take n Strat @ [Strat ! n]" by auto
 
 
   from take_Suc_conv_app_nth[OF ns] have tak: "take (Suc n) qs = take n qs @ [qs ! n]" by auto
 
   have aS: "length (take n Strat) = n" using Suc(3,4) by auto
   have aQ: "length (take n qs) = n" using Suc(4) by auto
   from aS aQ have qQS: "length (take n qs) = length (take n Strat)" by auto
 
   have xyininit: "x\<in> set init" "y : set init" by fact+
   then have xysubs: "{x,y} \<subseteq> set init" by auto
   have dI:  "distinct init" by fact
   have "set qs \<subseteq> set init" by fact
   then have qsnset: "qs ! n \<in> set init" using ns by auto
 
   from xyininit have ahjer: "set (Lxy init {x, y}) = {x,y}" 
     using xysubs by (simp add: Lxy_set_filter)
   with Suc(5) have ah: "card (set (Lxy init {x, y})) = 2" by simp
   have ahjer3: "distinct (Lxy init {x,y})"           
     apply(rule Lxy_distinct) by fact
   from ah have ahjer2: "length (Lxy init {x,y}) = 2"
     using distinct_card[OF ahjer3] by simp
 
   show ?case
   proof (cases "qs ! n \<in> {x,y}")
     case False
     with tak have nixzutun: "Lxy (take (Suc n) qs) {x,y}  = Lxy (take n qs) {x,y}"
       unfolding Lxy_def by simp
     let ?m="ALG_P' (take n Strat @ [Strat ! n]) (take n qs @ [qs ! n]) init n x y"
     let ?L="replicate ?m 0 @ sws" 
 
     {
       fix xs::"('a::linorder) list"
       fix m::nat
       fix q::'a
       assume "q \<notin> {x,y}"
       then have 5: "y \<noteq> q" by auto
       assume 1: "q \<in> set xs"
       assume 2: "distinct xs"
       assume 3: "x \<in> set xs"
       assume 4: "y \<in> set xs"
       have "(x < y in xs) = (x < y in (mtf2 m q xs))"
         by (metis "1" "2" "3" "4" \<open>q \<notin> {x, y}\<close> insertCI not_before_in set_mtf2 swapped_by_mtf2)
     } note f=this
 
     (* taktik, erstmal das mtf weg bekommen,
        dann induct über snd (Strat!n) *)
     have "(x < y in steps' init (take (Suc n) qs) (take (Suc n) Strat) (Suc n))
             = (x < y in mtf2 (fst (Strat ! n)) (qs ! n)
              (swaps (snd (Strat ! n)) (steps' init (take n qs) (take n Strat) n)))"       
       unfolding tak2 tak apply(simp only: steps'_append[OF qQS aQ] )
       by (simp add: step_def split_def) 
     also have "\<dots> = (x < y in (swaps (snd (Strat ! n)) (steps' init (take n qs) (take n Strat) n)))"
       apply(rule f[symmetric])
          apply(fact)
         using qsnset steps'_set[OF qQS] aS apply(simp)
        using steps'_distinct[OF qQS] aS dI apply(simp) 
       using steps'_set[OF qQS] aS xyininit by simp_all
     also have "\<dots> =  x < y in (swap 0 ^^ ALG_P (snd (Strat ! n)) x y (steps' init (take n qs) (take n Strat) n))
                                     (swaps sws (steps' (Lxy init {x, y}) (Lxy (take n qs) {x, y}) Strat2 (length Strat2)))"
        apply(rule projected_paid_same_effect)
             apply(rule steps'_dist_perm)
               apply(fact qQS)
              apply(fact aS)
             using dI apply(simp)
            apply(fact Suc(5))
           apply(simp)
           apply(rule steps'_set[where s="Lxy init {x,y}", unfolded ahjer])
            using len apply(simp)
           apply(simp)
          apply(simp)
          apply(rule steps'_length[where s="Lxy init {x,y}", unfolded ahjer2])
           using len apply(simp)
          apply(simp)
         apply(simp)
         apply(rule steps'_distinct2[where s="Lxy init {x,y}"])
           using len apply(simp)
          apply(simp)
         apply(fact)
        using iff by auto
                              
     finally have umfa: "x < y in steps' init (take (Suc n) qs) (take (Suc n) Strat) (Suc n) =
   x < y
   in (swap 0 ^^ ALG_P (snd (Strat ! n)) x y (steps' init (take n qs) (take n Strat) n))
       (swaps sws (steps' (Lxy init {x, y}) (Lxy (take n qs) {x, y}) Strat2 (length Strat2)))" .
 
     from Suc(3,4) have lS: "length (take n Strat) = n" by auto
     have "(take n Strat @ [Strat ! n]) ! n =
               (take n Strat @ (Strat ! n) # []) ! length (take n Strat)" using lS by auto
     also have "\<dots> = Strat ! n" by(rule nth_append_length)
     finally have tt: "(take n Strat @ [Strat ! n]) ! n = Strat ! n" .
 
     show ?thesis
       apply(rule exI[where x="Strat2"])
       apply(rule exI[where x="?L"])
       unfolding nixzutun
       apply(safe)
          apply(fact)
         proof goal_cases
           case 1
           show ?case 
           unfolding tak2 tak 
           apply(simp add: step_def split_def)
           unfolding ALG_P'_def
           unfolding tt
             using aS apply(simp only: steps'_rests[OF qQS, symmetric])
            using 1(1) umfa by auto 
         next
           case 2
           then show ?case  
           apply(simp add: step_def split_def)
           unfolding ALG_P'_def
           unfolding tt 
             using aS apply(simp only: steps'_rests[OF qQS, symmetric])
             using umfa[symmetric] by auto
         next
           case 3
           have ns2: "n < length (take n qs @ [qs ! n])"
               using ns by auto
 
           have er: "length (take n qs) < length Strat" 
             using Suc.prems(2) aQ ns by linarith
 
           have "T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2
       + length (replicate (ALG_P' Strat (take n qs @ [qs ! n]) init n x y) 0 @ sws)
       = ( T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2 + length sws)
           + ALG_P' Strat (take n qs @ [qs ! n])  init n x y" by simp
 
           also have "\<dots> =  ALGxy_det Strat (take n qs) init x y +
                   ALG_Pxy Strat (take n qs) init x y +
                   ALG_P' Strat (take n qs @ [qs ! n]) init n x y"
             unfolding T_Strat2 by simp
           also
           have "\<dots> = ALGxy_det Strat (take (Suc n) qs) init x y
               + ALG_Pxy Strat (take (Suc n) qs) init x y"
             unfolding tak unfolding wegdamit[OF er False] apply(simp) 
             unfolding ALG_P_split[of "take n qs" Strat "qs ! n" init x y, unfolded aQ, OF nStrat]
             by(simp)
           finally show ?case unfolding tak using ALG_P'_rest[OF ns nStrat] by auto 
         qed
   next
     case True
     note qsinxy=this
     then have yeh: "Lxy (take (Suc n) qs) {x, y} = Lxy (take n qs) {x,y} @ [qs!n]"
       unfolding tak Lxy_def by auto
 
     from True have garar: "(take n qs @ [qs ! n]) ! n \<in> {y, x}"
       using tak[symmetric] by(auto)
     have aer: "\<forall>i<n.
         ((take n qs @ [qs ! n]) ! i \<in> {y, x})
           = (take n qs ! i \<in> {y, x})" using ns by (metis less_SucI nth_take tak)
 
     (* erst definiere ich die zwischenzeitlichen Configurationen
                ?xs  \<rightarrow> ?xs'  \<rightarrow> ?xs''
         und
         ?ys \<rightarrow> ?ys' \<rightarrow> ?ys'' \<rightarrow> ?ys'''
 
         und einige Eigenschaften über sie
     *)
 
     (* what is the mtf action taken by Strat? *)
     let ?Strat_mft =  "fst (Strat ! n)"
     let ?Strat_sws =  "snd (Strat ! n)"
     (* what is the configuration before the step? *)  
     let ?xs = "steps' init (take n qs) (take n Strat) n"
     (* what is the configuration before the mtf *)
     let ?xs' = "(swaps (snd (Strat!n)) ?xs)"
     let ?xs'' = "steps' init (take (Suc n) qs) (take (Suc n) Strat) (Suc n)"
     let ?xs''2 = "mtf2 ?Strat_mft (qs!n) ?xs'"
     (* position of requested element *)
     let ?no_swap_occurs = "(x < y in ?xs') = (x < y in ?xs''2)"
 
     let ?mtf="(if ?no_swap_occurs then 0 else 1::nat)"
     let ?m="ALG_P' Strat (take n qs @ [qs ! n]) init n x y"
     let ?L="replicate ?m 0 @ sws"
 
     let ?newStrat="Strat2@[(?mtf,?L)]"
 
     have "?xs'' =  step ?xs (qs!n) (Strat!n)"
       unfolding tak tak2
       apply(rule steps'_append) by fact+
     also have "\<dots> = mtf2 (fst (Strat!n)) (qs!n) (swaps (snd (Strat!n)) ?xs)" unfolding step_def
       by (auto simp: split_def)
     finally have A: "?xs'' = mtf2 (fst (Strat!n)) (qs!n) ?xs'" . 
 
     let ?ys = "(steps' (Lxy init {x, y})
                   (Lxy (take n qs) {x, y}) Strat2 (length Strat2))"
     let ?ys' = "( swaps sws (steps' (Lxy init {x, y})
                   (Lxy (take n qs) {x, y}) Strat2 (length Strat2)))"
     let ?ys'' = " (swap 0 ^^ ALG_P (snd (Strat!n)) x y ?xs) ?ys'"
     let ?ys''' = "(steps' (Lxy init {x, y}) (Lxy (take (Suc n) qs) {x, y}) ?newStrat (length ?newStrat))"
 
     have gr: "Lxy (take n qs @ [qs ! n]) {x, y} = 
         Lxy (take n qs) {x, y} @ [qs ! n]" unfolding Lxy_def using True by(simp)
 
     have "steps' init (take n qs @ [qs ! n]) Strat n
       = steps' init (take n qs @ [qs ! n]) (take n Strat @ drop n Strat) n" by simp
     also have "\<dots> = steps' init (take n qs) (take n Strat) n"
           apply(subst steps'_rests[symmetric]) using aS qQS by(simp_all)
     finally have t: "steps' init (take n qs @ [qs ! n]) Strat n
         = steps' init (take n qs) (take n Strat) n" .
     have gge: "swaps (replicate ?m 0) ?ys'
         =  (swap 0 ^^ ALG_P (snd (Strat!n)) x y ?xs) ?ys'"
           unfolding ALG_P'_def t by simp
 
     have gg: "length ?newStrat = Suc (length Strat2)" by auto
     have "?ys''' =  step ?ys (qs!n) (?mtf,?L)"
           unfolding tak gr unfolding gg
           apply(rule steps'_append)
             using len by auto
     also have "\<dots> = mtf2 ?mtf (qs!n) (swaps ?L ?ys)"
           unfolding step_def by (simp add: split_def)
     also have "\<dots> = mtf2 ?mtf (qs!n) (swaps (replicate ?m 0) ?ys')"
       by (simp)
     also have "\<dots> = mtf2 ?mtf (qs!n) ?ys''"
       using gge by (simp)
     finally have B: "?ys''' = mtf2 ?mtf (qs!n) ?ys''" .
  
     have 3: "set ?ys' = {x,y}"
       apply(simp add: swaps_inv) apply(subst steps'_set) using ahjer len by(simp_all)  
     have k: "?ys'' = swaps (replicate (ALG_P (snd (Strat!n)) x y ?xs) 0) ?ys'"
       by (auto)
     have 6: "set ?ys'' = {x,y}" unfolding k using 3 swaps_inv by metis
     have 7: "set ?ys''' = {x,y}" unfolding B using set_mtf2 6 by metis                              
     have 22: "x \<in> set ?ys''" "y \<in> set ?ys''" using 6 by auto
     have 23: "x \<in> set ?ys'''" "y \<in> set ?ys'''" using 7 by auto
 
     have 26: "(qs!n) \<in> set ?ys''" using 6 True by auto
 
     have "distinct ?ys" apply(rule steps'_distinct2)
       using len ahjer3 by(simp)+
     then have 9: "distinct ?ys'" using swaps_inv by metis              
     then have 27: "distinct ?ys''" unfolding k  using swaps_inv by metis
 
     from 3 Suc(5) have "card (set ?ys') = 2" by auto
     then have 4: "length ?ys' = 2" using distinct_card[OF 9] by simp
     have "length ?ys'' = 2" unfolding k using 4 swaps_inv by metis
     have 5: "dist_perm ?ys' ?ys'" using 9 by auto
 
     have sxs: "set ?xs = set init" apply(rule steps'_set) using qQS n Suc(3) by(auto)
     have sxs': "set ?xs' = set ?xs" using swaps_inv by metis
     have sxs'': "set ?xs'' = set ?xs'" unfolding A using set_mtf2 by metis
     have 24: "x \<in> set ?xs'" "y\<in>set ?xs'" "(qs!n) \<in> set ?xs'" 
         using xysubs True sxs sxs' by auto
     have 28: "x \<in> set ?xs''" "y\<in>set ?xs''" "(qs!n) \<in> set ?xs''"  
         using xysubs True sxs sxs' sxs'' by auto
 
     have 0: "dist_perm init init" using dI by auto
     have 1: "dist_perm ?xs ?xs" apply(rule steps'_dist_perm)
       by fact+
     then have 25: "distinct ?xs'" using swaps_inv by metis
 
 
     (* aus der Induktionsvorraussetzung (iff) weiß ich bereits
         dass die Ordnung erhalten wird bis zum nten Schritt,
         mit Theorem "projected_paid_same_effect" kann ich auch die paid exchanges abarbeiten ...*)
 
     from projected_paid_same_effect[OF 1 Suc(5) 3 4 5, OF iff, where acs="snd (Strat ! n)"]
     have aaa: "x < y in ?xs'  = x < y in ?ys''" .
 
     (* ... was nun noch fehlt ist, dass die moveToFront anweisungen von Strat
         und Strat2 sich in gleicher Art auf die Ordnung von x und y auswirken
     *)
 
     have t: "?mtf = (if (x<y in ?xs') = (x<y in ?xs'') then 0 else 1)"
       by (simp add: A)
 
     have central: "x < y in ?xs'' = x < y  in ?ys'''"
     proof (cases "(x<y in ?xs') = (x<y in ?xs'')")
       case True
       then have "?mtf = 0" using t by auto
       with B have "?ys''' = ?ys''" by auto
       with aaa True show ?thesis by auto
     next
       case False
       then have k: "?mtf = 1" using t by auto
       from False have i: "(x<y in ?xs') = (~x<y in ?xs'')" by auto
 
       have gn: "\<And>a b. a\<in>{x,y} \<Longrightarrow> b\<in>{x,y} \<Longrightarrow> set ?ys'' = {x,y} \<Longrightarrow>
                   a\<noteq>b \<Longrightarrow> distinct ?ys'' \<Longrightarrow>
                   a<b in ?ys'' \<Longrightarrow> ~a<b in mtf2 1 b ?ys''"
       proof goal_cases
         case (1 a b)
         from 1 have f: "set ?ys'' = {a,b}" by auto
         with 1 have i: "card (set ?ys'') = 2" by auto
         from 1(5) have "dist_perm ?ys'' ?ys''" by auto 
         from i distinct_card 1(5) have g: "length ?ys'' = 2" by metis
         with 1(6) have d: "index ?ys'' b = 1"
           using before_in_index2 f 1(4) by fastforce
         from 1(2,3) have e: "b \<in> set ?ys''" by auto
 
         from d e have p: "mtf2 1 b ?ys'' = swap 0 ?ys''"
           unfolding mtf2_def by auto
         have q: "a < b in swap 0 ?ys'' = (\<not> a < b in ?ys'')"
           apply(rule swap0in2) by(fact)+
         from 1(6) p q show ?case by metis
       qed
 
       show ?thesis
       proof (cases "x<y in ?xs'")
         case True
         with aaa have st: "x < y in ?ys''" by auto
         from True False have "~ x<y in ?xs''" by auto
         with Suc(5) 28 not_before_in A have "y < x in ?xs''" by metis
         with A have "y < x in mtf2 (fst (Strat!n)) (qs!n) ?xs'" by auto
         (*from True swapped_by_mtf2*)
         have itisy: "y = (qs!n)"
           apply(rule swapped_by_mtf2[where xs= ?xs'])
                apply(fact)
               apply(fact)
              apply(fact 24)
             apply(fact 24)
            by(fact)+
         have "~x<y in mtf2 1 y ?ys''" 
           apply(rule gn)
                apply(simp)
               apply(simp)
              apply(simp add: 6)
             by(fact)+
         then have ts: "~x<y in ?ys'''" using B itisy k by auto
         have ii: "(x<y in ?ys'') = (~x<y in ?ys''')" using st ts by auto
         from i ii aaa show ?thesis by metis
       next
         case False
         with aaa have st: "~ x < y in ?ys''" by auto
         with Suc(5) 22 not_before_in have st: "y < x in ?ys''" by metis
         from i False have kl: "x<y in ?xs''" by auto
         with A have "x < y in mtf2 (fst (Strat!n)) (qs!n) ?xs'" by auto
         from False Suc(5) 24 not_before_in have "y < x in ?xs'" by metis
         have itisx: "x = (qs!n)"
           apply(rule swapped_by_mtf2[where xs= ?xs'])
                apply(fact)
               apply(fact)
              apply(fact 24(2))
             apply(fact 24)
            by(fact)+
         have "~y<x in mtf2 1 x ?ys''"
           apply(rule gn)
                apply(simp)
               apply(simp)
              apply(simp add: 6)
             apply(metis Suc(5))
            by(fact)+
         then have "~y<x in ?ys'''" using itisx k B by auto
         with Suc(5) not_before_in 23 have "x<y in ?ys'''" by metis
         with st have "(x<y in ?ys'') = (~x<y in ?ys''')" using  B k by auto
         with i aaa show ?thesis by metis
       qed
     qed
 
     show ?thesis
       apply(rule exI[where x="?newStrat"])
       apply(rule exI[where x="[]"])
       proof (standard, goal_cases)
         case 1
         show ?case unfolding yeh using len by(simp)
       next
         case 2
         show ?case
         proof (standard, goal_cases)
           case 1
           (* hier beweise ich also, dass die ordnung von x und y in der projezierten
              Ausführung (von Strat2) der Ordnung von x und y in der Ausführung
              von Strat entspricht *)
           from central show ?case by auto
         next
           case 2 
           (* nun muss noch bewiesen werden, dass die Kosten sich richtig aufspalten:
              Kosten für Strat2 + |sws|
              = blocking kosten von x,y + paid exchange kosten von x,y
           *)
           have j: "ALGxy_det Strat (take (Suc n) qs) init x y =
             ALGxy_det Strat (take n qs) init x y 
                   + (ALG'_det Strat qs init n y + ALG'_det Strat qs init n x)" 
           proof -
             have "ALGxy_det Strat (take (Suc n) qs) init x y =
               (\<Sum>i\<in>{..<length (take n qs @ [qs ! n])}.
               if (take n qs @ [qs ! n]) ! i \<in> {y, x}
               then ALG'_det Strat (take n qs @ [qs ! n]) init i y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init i x
               else 0)" unfolding ALGxy_det_def tak by auto
             also have "\<dots>
               =  (\<Sum>i\<in>{..<Suc n}.
               if (take n qs @ [qs ! n]) ! i \<in> {y, x}
               then ALG'_det Strat (take n qs @ [qs ! n]) init i y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init i x
               else 0)" using ns by simp
             also have "\<dots> = (\<Sum>i\<in>{..<n}.
                if (take n qs @ [qs ! n]) ! i \<in> {y, x}
                then ALG'_det Strat (take n qs @ [qs ! n]) init i y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init i x
                else 0)
                + (if (take n qs @ [qs ! n]) ! n \<in> {y, x}
                   then ALG'_det Strat (take n qs @ [qs ! n]) init n y
                     + ALG'_det Strat (take n qs @ [qs ! n]) init n x
                   else 0)" by simp
             also have "\<dots> = (\<Sum>i\<in>{..< n}.
               if take n qs ! i \<in> {y, x}
               then ALG'_det Strat (take n qs @ [qs ! n]) init i y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init i x
               else 0)
                 + ALG'_det Strat (take n qs @ [qs ! n]) init n y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init n x "
               using aer using garar by simp
             also have "\<dots> = (\<Sum>i\<in>{..< n}.
               if take n qs ! i \<in> {y, x}
               then ALG'_det Strat (take n qs @ [qs ! n]) init i y
                 + ALG'_det Strat (take n qs @ [qs ! n]) init i x
               else 0)
                 + ALG'_det Strat qs init n y + ALG'_det Strat qs init n x"
             proof -
               have "ALG'_det Strat qs init n y
                 = ALG'_det Strat ((take n qs @ [qs ! n]) @ drop (Suc n) qs) init n y"
                 unfolding tak[symmetric] by auto                   
               also have "\<dots> = ALG'_det Strat (take n qs @ [qs ! n]) init n y "
                 apply(rule ALG'_det_append) using nStrat ns by(auto)
               finally have 1: "ALG'_det Strat qs init n y = ALG'_det Strat (take n qs @ [qs ! n]) init n y" .
               have "ALG'_det Strat qs init n x
                   = ALG'_det Strat ((take n qs @ [qs ! n]) @ drop (Suc n) qs) init n x"
                 unfolding tak[symmetric] by auto                   
               also have "\<dots> = ALG'_det Strat (take n qs @ [qs ! n]) init n x "
                 apply(rule ALG'_det_append) using nStrat ns by(auto)
               finally have 2: "ALG'_det Strat qs init n x = ALG'_det Strat (take n qs @ [qs ! n]) init n x" .
               from 1 2 show ?thesis by auto
             qed
             also have "\<dots> = (\<Sum>i\<in>{..< n}.
               if take n qs ! i \<in> {y, x}
               then ALG'_det Strat (take n qs) init i y
                   + ALG'_det Strat (take n qs) init i x
               else 0)
               + ALG'_det Strat qs init n y + ALG'_det Strat qs init n x"
               apply(simp)
               apply(rule sum.cong)
                apply(simp)
               apply(simp)
               using ALG'_det_append[where qs="take n qs"] Suc.prems(2) ns by auto
             also have "\<dots> = (\<Sum>i\<in>{..< length(take n qs)}.
               if take n qs ! i \<in> {y, x}
               then ALG'_det Strat (take n qs) init i y
                    + ALG'_det Strat (take n qs) init i x
               else 0)
               + ALG'_det Strat qs init n y + ALG'_det Strat qs init n x"
               using aQ by auto
             also have "\<dots> = ALGxy_det Strat (take n qs) init x y 
                   + (ALG'_det Strat qs init n y + ALG'_det Strat qs init n x)"
               unfolding ALGxy_det_def by(simp)
             finally show ?thesis .
           qed
 
            (* 
               aaa:      x < y in ?xs'  = x < y in ?ys''
               central:  x < y in ?xs'' = x < y  in ?ys''' 
            *) 
 
           have list: "?ys' = swaps sws (steps (Lxy init {x, y})  (Lxy (take n qs) {x, y}) Strat2)"
             unfolding steps_steps'[OF len[symmetric], of "(Lxy init {x, y})"] by simp
 
           have j2: "steps' init (take n qs @ [qs ! n]) Strat n
                   = steps' init (take n qs) (take n Strat) n"
           proof -
             have "steps' init (take n qs @ [qs ! n]) Strat n
                 = steps' init (take n qs @ [qs ! n]) (take n Strat @ drop n Strat) n"
             by auto
             also have "\<dots> = steps' init (take n qs) (take n Strat) n"
               apply(rule steps'_rests[symmetric]) apply fact using aS by simp
             finally show ?thesis .
           qed
 
           have arghschonwieder: "steps' init (take n qs) (take n Strat) n
                   = steps' init qs Strat n"
           proof -
             have "steps' init qs Strat n
                 = steps' init (take n qs @ drop n qs) (take n Strat @ drop n Strat) n"
               by auto
             also have "\<dots> = steps' init (take n qs) (take n Strat) n"
                apply(rule steps'_rests[symmetric]) apply fact using aS by simp
             finally show ?thesis by simp
           qed
  
           have indexe: "((swap 0 ^^ ?m) (swaps sws 
                       (steps (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2))) 
               = ?ys''" unfolding ALG_P'_def unfolding list using j2 by auto
 
           have blocky: "ALG'_det Strat qs init n y
                 = (if y < qs ! n in ?xs' then 1 else 0)"
             unfolding ALG'_det_def ALG.simps by(auto simp: arghschonwieder split_def)
           have blockx: "ALG'_det Strat qs init n x
                 = (if x < qs ! n in ?xs' then 1 else 0)"
             unfolding ALG'_det_def ALG.simps by(auto simp: arghschonwieder split_def)
 
           have index_is_blocking_cost: "index  ((swap 0 ^^ ?m) (swaps sws
                         (steps (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2))) (qs ! n)
                       = ALG'_det Strat qs init n y + ALG'_det Strat qs init n x"
           proof (cases "x= qs!n")
             case True
             then have "ALG'_det Strat qs init n x = 0"
               unfolding blockx apply(simp) using before_in_irefl by metis
             then have "ALG'_det Strat qs init n y + ALG'_det Strat qs init n x
                   = (if y < x in ?xs' then 1 else 0)" unfolding blocky using True by simp
             also have "\<dots> = (if ~y < x in ?xs' then 0 else 1)" by auto
             also have "\<dots> = (if x < y in ?xs' then 0 else 1)"
               apply(simp) by (meson 24 Suc.prems(4) not_before_in)
             also have "\<dots> = (if x < y in ?ys'' then 0 else 1)" using aaa by simp
             also have "\<dots> = index ?ys'' x"
               apply(rule before_in_index1) by(fact)+
             finally show ?thesis unfolding indexe using True by auto 
           next
             case False
             then have q: "y = qs!n" using qsinxy by auto
             then have "ALG'_det Strat qs init n y = 0"
               unfolding blocky apply(simp) using before_in_irefl by metis
             then have "ALG'_det Strat qs init n y + ALG'_det Strat qs init n x
                   = (if x < y in ?xs' then 1 else 0)" unfolding blockx using q by simp 
             also have "\<dots> = (if x < y in ?ys'' then 1 else 0)" using aaa by simp
             also have "\<dots> = index ?ys'' y"
               apply(rule before_in_index2) by(fact)+
             finally show ?thesis unfolding indexe using q by auto
           qed
 
           have jj: "ALG_Pxy Strat (take (Suc n) qs) init x y =
                 ALG_Pxy Strat (take n qs) init x y
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y"
           proof -
             have "ALG_Pxy Strat (take (Suc n) qs) init x y
                   = (\<Sum>i<length (take (Suc n) qs). ALG_P' Strat (take (Suc n) qs) init i x y)" 
               unfolding ALG_Pxy_def by simp
             also have "\<dots> = (\<Sum>i< Suc n. ALG_P' Strat (take (Suc n) qs) init i x y)"
               unfolding tak using ns by simp
             also have "\<dots> = (\<Sum>i<n. ALG_P' Strat (take (Suc n) qs) init i x y)
                   + ALG_P' Strat (take (Suc n) qs) init n x y"
               by simp
             also have "\<dots> = (\<Sum>i<length (take n qs). ALG_P' Strat (take n qs @ [qs ! n]) init i x y)
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y"
               unfolding tak using ns by auto
             also have "\<dots> = (\<Sum>i<length (take n qs). ALG_P' Strat (take n qs) init i x y) 
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y" (is "?A + ?B = ?A' + ?B")
             proof -
               have "?A = ?A'"
                 apply(rule sum.cong)
                   apply(simp)
                  proof goal_cases
                    case 1
                    show ?case
                      apply(rule ALG_P'_rest2[symmetric, where ?r1.0="[]", simplified])
                        using 1 apply(simp)
                       using 1 nStrat by(simp)
                  qed
                  then show ?thesis by auto
             qed                        
             also have "\<dots> = ALG_Pxy Strat (take n qs) init x y
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y" 
                     unfolding ALG_Pxy_def by auto
             finally show ?thesis .
           qed
 
           have tw: "length (Lxy (take n qs) {x, y}) = length Strat2" 
             using len by auto
           have "T\<^sub>p (Lxy init {x,y}) (Lxy (take (Suc n) qs) {x, y}) ?newStrat + length []
                  = T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2
                   + t\<^sub>p (steps (Lxy init {x, y}) (Lxy (take n qs) {x, y}) Strat2) (qs ! n) (?mtf,?L)" 
             unfolding yeh
             by(simp add: T_append[OF tw, of "(Lxy init) {x,y}"]) 
           also have "\<dots> = 
                  T\<^sub>p (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2
                   + length sws
                   + index ((swap 0 ^^ ?m) (swaps sws
                         (steps (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2))) (qs ! n)
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y"
             by(simp add: t\<^sub>p_def)
           (* now use iH *)
           also have "\<dots> = (ALGxy_det Strat (take n qs) init x y 
                   + index ((swap 0 ^^ ?m) (swaps sws
                         (steps (Lxy init {x,y}) (Lxy (take n qs) {x, y}) Strat2))) (qs ! n))
                   + (ALG_Pxy Strat (take n qs) init x y
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y)"
             by (simp only: T_Strat2)
           (* the current cost are equal to the blocking costs: *)   
           also from index_is_blocking_cost have "\<dots> = (ALGxy_det Strat (take n qs) init x y 
                   + ALG'_det Strat qs init n y + ALG'_det Strat qs init n x)
                   + (ALG_Pxy Strat (take n qs) init x y
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y)" by auto
           also have "\<dots> = ALGxy_det Strat (take (Suc n) qs) init x y 
                   + (ALG_Pxy Strat (take n qs) init x y
                   + ALG_P' Strat (take n qs @ [qs ! n]) init n x y)" using j by auto
           also have "\<dots> = ALGxy_det Strat (take (Suc n) qs) init x y 
                   + ALG_Pxy Strat (take (Suc n) qs) init x y" using jj by auto
           finally show ?case .
         qed
       qed
     qed
 next 
   case 0
   then show ?case
     apply (simp add: Lxy_def ALGxy_det_def ALG_Pxy_def T_opt_def)
     proof goal_cases
       case 1
         show ?case apply(rule Lxy_mono[unfolded Lxy_def, simplified])
           using 1 by auto
     qed
 qed
 
 
 lemma T1_7:
 assumes "T\<^sub>p init qs Strat = T\<^sub>p_opt init qs" "length Strat = length qs"
   "x \<noteq> (y::('a::linorder))" "x\<in> set init" "y \<in> set init" "distinct init"
   "set qs \<subseteq> set init"
 shows "T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y})
   \<le> ALGxy_det Strat qs init x y + ALG_Pxy Strat qs init x y"
 proof -
   have A:"length qs \<le> length qs" by auto
   have B:"  x \<noteq> y " using assms by auto
 
   from T1_7'[OF assms(1,2), of "length qs" x y, OF A B assms(4-7)]
   obtain Strat2 sws where 
       len: "length Strat2 = length (Lxy qs {x, y})"
      and "x < y in steps' init qs (take (length qs) Strat)
          (length qs) = x < y in swaps sws (steps' (Lxy init {x,y})
            (Lxy qs {x, y}) Strat2 (length Strat2))"
      and Tp: "T\<^sub>p (Lxy init {x,y}) (Lxy qs {x, y}) Strat2 + length sws
         =  ALGxy_det Strat qs init x y 
          + ALG_Pxy Strat qs init x y" by auto
 
   have "T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y}) \<le> T\<^sub>p (Lxy init {x,y}) (Lxy qs {x, y}) Strat2"
     unfolding T_opt_def
     apply(rule cInf_lower)
       using len by auto
   also have "\<dots> \<le> ALGxy_det Strat qs init x y 
          + ALG_Pxy Strat qs init x y" using Tp by auto
   finally show ?thesis .
 qed
 
 lemma T_snoc: "length rs = length as
        \<Longrightarrow>  T init (rs@[r]) (as@[a])
         = T init rs as + t\<^sub>p (steps' init rs as (length rs)) r a"
 apply(induct rs as arbitrary: init rule: list_induct2) by simp_all
 
 lemma steps'_snoc: "length rs = length as \<Longrightarrow> n = (length as)
        \<Longrightarrow> steps' init (rs@[r]) (as@[a]) (Suc n) = step (steps' init rs as n) r a"
 apply(induct rs as arbitrary: init n r a rule: list_induct2)
   by (simp_all) 
 
 lemma steps'_take:
   assumes "n<length qs" "length qs = length Strat" 
   shows "steps' init (take n qs) (take n Strat) n
       = steps' init qs Strat n"                       
 proof -
   have "steps' init qs Strat n =
     steps' init (take n qs @ drop n qs) (take n Strat @ drop n Strat) n"  by simp
   also have "\<dots> = steps' init (take n qs) (take n Strat) n"
       apply(subst steps'_rests[symmetric]) using assms  by auto
   finally show ?thesis by simp
 qed
 
 lemma Tp_darstellung: "length qs = length Strat
         \<Longrightarrow> T\<^sub>p init qs Strat =
         (\<Sum>i\<in>{..<length qs}. t\<^sub>p (steps' init qs Strat i) (qs!i) (Strat!i))"   
 proof -
   assume a[simp]: "length qs = length Strat"
   {fix n
       have "n\<le>length qs
         \<Longrightarrow> T\<^sub>p init (take n qs) (take n Strat) =
         (\<Sum>i\<in>{..<n}. t\<^sub>p (steps' init qs Strat i) (qs!i) (Strat!i))" 
       apply(induct n) 
         apply(simp)
        apply(simp add: take_Suc_conv_app_nth)
        apply(subst T_snoc)
          apply(simp)
         by(simp add: min_def steps'_take) 
   }
   from a this[of "length qs"] show ?thesis by auto
 qed
 
          
 (* Gleichung 1.8 in Borodin *)
 lemma umformung_OPT':
   assumes inlist: "set qs \<subseteq> set init"
   assumes dist: "distinct init"
   assumes qsStrat: "length qs = length Strat"
   assumes noStupid: "\<And>x l. x<length Strat \<Longrightarrow> l< length (snd (Strat ! x)) \<Longrightarrow> Suc ((snd (Strat ! x))!l)  < length init"
   shows "T\<^sub>p init qs Strat = 
     (\<Sum>(x,y)\<in>{(x,y::('a::linorder)). x \<in> set init \<and> y\<in>set init \<and> x<y}.
           ALGxy_det Strat qs init x y + ALG_Pxy Strat qs init x y)"
 proof -
  (* have config_dist: "\<forall>n. \<forall>xa \<in> set_pmf (config\<^sub>p (I, S) qs init n). distinct (snd xa)"
       using dist config_rand_distinct by metis
 *) 
 
   (* ersten Teil umformen: *)
   have "(\<Sum>i\<in>{..<length qs}.
     (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )
                 = (\<Sum>i\<in>{..<length qs}. 
                (\<Sum>z\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) (fst z) (snd z) (steps' init qs Strat i)) )"
           by(auto simp: split_def)
   also have "\<dots>
        = (\<Sum>z\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                 (\<Sum>i\<in>{..<length qs}. ALG_P (snd (Strat!i)) (fst z) (snd z) (steps' init qs Strat i)) )" 
           by(rule sum.swap)
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                 (\<Sum>i\<in>{..<length qs}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )"
           by(auto simp: split_def)
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                 ALG_Pxy Strat qs init x y)"
           unfolding ALG_P'_def ALG_Pxy_def by auto
   finally have paid_part: "(\<Sum>i\<in>{..<length qs}.
     (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )
       = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                 ALG_Pxy Strat qs init x y)" .
 
   (* zweiten Teil umformen: *)
   
   let ?config = "(%i. swaps (snd (Strat!i)) (steps' init qs Strat i))"
 
   have "(\<Sum>i\<in>{..<length qs}. 
                 (\<Sum>e\<in>set init. ALG e qs i (?config i, ())))
         = (\<Sum>e\<in>set init. 
             (\<Sum>i\<in>{..<length qs}. ALG e qs i (?config i, ())))" 
             by(rule sum.swap)
   also have "\<dots> = (\<Sum>e\<in>set init.
           (\<Sum>y\<in>set init.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG e qs i (?config i,()))))"
             proof (rule sum.cong, goal_cases)
               case (2 x)
               have "(\<Sum>i<length qs. ALG x qs i (?config i, ()))
                 = sum (%i. ALG x qs i (?config i, ())) {i. i<length qs}" 
                 by (simp add: lessThan_def) 
               also have "\<dots> = sum (%i. ALG x qs i (?config i, ())) 
                         (\<Union>y\<in>{y. y \<in> set init}. {i. i < length qs \<and> qs ! i = y})"
                          apply(rule sum.cong)
                          proof goal_cases
                           case 1                          
                           show ?case apply(auto) using inlist by auto
                          qed simp
               also have "\<dots> = sum (%t. sum (%i. ALG x qs i (?config i, ())) {i. i<length qs \<and> qs ! i = t}) {y. y\<in> set init}"
                 apply(rule sum.UNION_disjoint)
                   apply(simp_all) by force
               also have "\<dots> = (\<Sum>y\<in>set init. \<Sum>i | i < length qs \<and> qs ! i = y.
                        ALG x qs i (?config i, ()))" by auto                  
              finally show ?case .
             qed (simp)
    also have "\<dots> = (\<Sum>(x,y)\<in> (set init \<times> set init).
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG x qs i (?config i, ())))"
        by (rule sum.cartesian_product)
    also have "\<dots> = (\<Sum>(x,y)\<in> {(x,y). x\<in>set init \<and> y\<in> set init}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG x qs i (?config i, ())))"
             by simp
    also have E4: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x\<in>set init \<and> y\<in> set init \<and> x\<noteq>y}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG x qs i (?config i, ())))" (is "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f x y)")
            proof goal_cases
         case 1
         let ?M = "{(x,y). x\<in>set init \<and> y\<in> set init \<and> x=y}"
         have A: "?L = ?R \<union> ?M" by auto
         have B: "{} = ?R \<inter> ?M" by auto
         have "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R \<union> ?M. ?f x y)"
           by(simp only: A)
         also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?M. ?f x y)"
             apply(rule sum.union_disjoint)
               apply(rule finite_subset[where B="set init \<times> set init"])
                 apply(auto)
               apply(rule finite_subset[where B="set init \<times> set init"])
                 by(auto)
         also have "(\<Sum>(x,y)\<in> ?M. ?f x y) = 0"
           apply(rule sum.neutral)
             by (auto simp add: split_def before_in_def) 
         finally show ?case by simp
       qed
 
    also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
             (\<Sum>i\<in>{i. i<length qs \<and> qs!i=y}. ALG x qs i (?config i, ()))
            + (\<Sum>i\<in>{i. i<length qs \<and> qs!i=x}. ALG y qs i (?config i, ())) )"
             (is "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f x y +  ?f y x)")
               proof -
                 let ?R' = "{(x,y). x \<in> set init \<and> y\<in>set init \<and> y<x}"
                 have A: "?L = ?R \<union> ?R'" by auto
                 have "{} = ?R \<inter> ?R'" by auto
                 have C: "?R' = (%(x,y). (y, x)) ` ?R" by auto
 
                 have D: "(\<Sum>(x,y)\<in> ?R'. ?f x y) = (\<Sum>(x,y)\<in> ?R. ?f y x)"
                 proof -
                   have "(\<Sum>(x,y)\<in> ?R'. ?f x y) = (\<Sum>(x,y)\<in> (%(x,y). (y, x)) ` ?R. ?f x y)"
                       by(simp only: C)
                   also have "(\<Sum>z\<in> (%(x,y). (y, x)) ` ?R. (%(x,y). ?f x y) z) = (\<Sum>z\<in>?R. ((%(x,y). ?f x y) \<circ> (%(x,y). (y, x))) z)"
                     apply(rule sum.reindex)
                       by(fact swap_inj_on)
                   also have "\<dots> = (\<Sum>z\<in>?R. (%(x,y). ?f y x) z)"
                     apply(rule sum.cong)
                       by(auto)
                   finally show ?thesis .                  
               qed
 
                 have "(\<Sum>(x,y)\<in> ?L. ?f x y) = (\<Sum>(x,y)\<in> ?R \<union> ?R'. ?f x y)"
                   by(simp only: A) 
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?R'. ?f x y)"
                   apply(rule sum.union_disjoint) 
                     apply(rule finite_subset[where B="set init \<times> set init"])
                       apply(auto)
                     apply(rule finite_subset[where B="set init \<times> set init"])
                       by(auto)
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y) + (\<Sum>(x,y)\<in> ?R. ?f y x)"
                     by(simp only: D)                  
                 also have "\<dots> = (\<Sum>(x,y)\<in> ?R. ?f x y + ?f y x)"
                   by(simp add: split_def sum.distrib[symmetric])
               finally show ?thesis .
             qed
                 
    also have E5: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
             (\<Sum>i\<in>{i. i<length qs \<and> (qs!i=y \<or> qs!i=x)}. ALG y qs i (?config i, ()) + ALG x qs i (?config i, ())))"
     apply(rule sum.cong)
       apply(simp)
       proof goal_cases
         case (1 x)
         then obtain a b where x: "x=(a,b)" and a: "a \<in> set init" "b \<in> set init" "a < b" by auto
         then have "a\<noteq>b" by simp
         then have disj: "{i. i < length qs \<and> qs ! i = b} \<inter> {i. i < length qs \<and> qs ! i = a} = {}" by auto
         have unio: "{i. i < length qs \<and> (qs ! i = b \<or> qs ! i = a)}
             = {i. i < length qs \<and> qs ! i = b} \<union> {i. i < length qs \<and> qs ! i = a}" by auto 
         let ?f="%i. ALG b qs i (?config i, ()) +
                ALG a qs i (?config i, ())"
         let ?B="{i. i < length qs \<and> qs ! i = b}"
         let ?A="{i. i < length qs \<and> qs ! i = a}"
         have "(\<Sum>i\<in>?B \<union> ?A. ?f i)
                = (\<Sum>i\<in>?B. ?f i) + (\<Sum>i\<in>?A. ?f i) - (\<Sum>i\<in>?B \<inter> ?A. ?f i) "
           apply(rule sum_Un_nat) by auto  
         also have "\<dots> = (\<Sum>i\<in>?B. ALG b qs i (?config i, ()) + ALG a qs i (?config i, ()))
                     + (\<Sum>i\<in>?A. ALG b qs i (?config i, ()) + ALG a qs i (?config i, ()))"
           using disj by auto
         also have "\<dots> = (\<Sum>i\<in>?B. ALG a qs i (?config i, ()))
                   + (\<Sum>i\<in>?A. ALG b qs i (?config i, ()))"
           by (auto simp: split_def before_in_def)
         finally 
             show ?case unfolding x apply(simp add: split_def)
           unfolding unio by simp
      qed    
      also have E6: "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                   ALGxy_det Strat qs init x y)"
            apply(rule sum.cong)
            unfolding ALGxy_det_alternativ unfolding ALG'_det_def by auto
      finally have blockingpart: "(\<Sum>i<length qs. 
                          \<Sum>e\<in>set init.
                               ALG e qs i (?config i, ()))
                  = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. 
                          ALGxy_det Strat qs init x y) " .
   from Tp_darstellung[OF qsStrat] have E0: "T\<^sub>p init qs Strat =
         (\<Sum>i\<in>{..<length qs}. t\<^sub>p (steps' init qs Strat i) (qs!i) (Strat!i))"
           by auto
   also have "\<dots> = (\<Sum>i\<in>{..<length qs}. 
                 (\<Sum>e\<in>set (steps' init qs Strat i). ALG e qs i (swaps (snd (Strat!i)) (steps' init qs Strat i),()))
 + (\<Sum>(x,y)\<in>{(x,(y::('a::linorder))). x \<in> set (steps' init qs Strat i) \<and> y\<in>set (steps' init qs Strat i) \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )"
     apply(rule sum.cong)
       apply(simp)
      apply (rule t\<^sub>p_sumofALGALGP) 
          apply(rule steps'_distinct2)
            using dist qsStrat apply(simp_all)
         apply(subst steps'_set)
           using dist qsStrat inlist apply(simp_all)
        apply fastforce
       apply(subst steps'_length)
         apply(simp_all)
           using noStupid by auto 
   also have "\<dots> = (\<Sum>i\<in>{..<length qs}. 
                 (\<Sum>e\<in>set init. ALG e qs i (swaps (snd (Strat!i)) (steps' init qs Strat i),()))
 + (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )"
                 apply(rule sum.cong)
                   apply(simp) 
                   proof goal_cases
                     case (1 x)
                     then have "set (steps' init qs Strat x) = set init"
                       apply(subst steps'_set)
                       using dist qsStrat 1 by(simp_all)
                     then show ?case by simp
                   qed 
   also have "\<dots> = (\<Sum>i\<in>{..<length qs}. 
                 (\<Sum>e\<in>set init. ALG e qs i (swaps (snd (Strat!i)) (steps' init qs Strat i), ())))
                + (\<Sum>i\<in>{..<length qs}. 
                (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )"
     by (simp add: sum.distrib split_def) 
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. 
                          ALGxy_det Strat qs init x y)
                + (\<Sum>i\<in>{..<length qs}. 
                (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. ALG_P (snd (Strat!i)) x y (steps' init qs Strat i)) )"
                 by(simp only: blockingpart)
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. 
                          ALGxy_det Strat qs init x y)
                + (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
                 ALG_Pxy Strat qs init x y)"
                 by(simp only: paid_part)
   also have "\<dots> = (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. 
                          ALGxy_det Strat qs init x y
                +   ALG_Pxy Strat qs init x y)"
     by (simp add: sum.distrib split_def) 
   finally show ?thesis by auto
 qed
 
 
 
 
 lemma nn_contains_Inf:
   fixes S :: "nat set"
   assumes nn: "S \<noteq> {}"
   shows "Inf S \<in> S"
 using assms Inf_nat_def LeastI by force
 
 
 lemma steps_length: "length qs = length as \<Longrightarrow> length (steps s qs as) = length s"
 apply(induct qs as arbitrary: s rule: list_induct2)
    by simp_all
 
 (* shows that OPT does not use paid exchanges that do not have an effect *)
 lemma OPT_noStupid:
   fixes Strat
   assumes [simp]: "length Strat = length qs"
   assumes opt: "T\<^sub>p init qs Strat = T\<^sub>p_opt init qs"
   assumes init_nempty: "init\<noteq>[]"
   shows "\<And>x l. x < length Strat \<Longrightarrow>
         l < length (snd (Strat ! x)) \<Longrightarrow>
        Suc ((snd (Strat ! x))!l) < length init"
 proof (rule ccontr, goal_cases)
   case (1 x l)
 
   (* construct a Stratgy that leaves out that paid exchange *)
   let ?sws' = "take l (snd (Strat!x)) @ drop (Suc l) (snd (Strat!x))"
   let ?Strat' = "take x Strat @ (fst (Strat!x),?sws') # drop (Suc x) Strat"
 
   from 1(1) have valid: "length ?Strat' = length qs" by simp
   from valid have isin: "T\<^sub>p init qs ?Strat' \<in> {T\<^sub>p init qs as |as. length as = length qs}" by blast
 
   from 1(1,2) have lsws': "length (snd (Strat!x)) = length ?sws' + 1"
     by (simp)
 
   have a: "(take x ?Strat') = (take x Strat)"
     using 1(1) by(auto simp add: min_def take_Suc_conv_app_nth)
   have b: "(drop (Suc x) Strat) = (drop (Suc x) ?Strat')"
     using 1(1) by(auto simp add: min_def take_Suc_conv_app_nth)
 
   have aa: "(take l (snd (Strat!x))) = (take l (snd (?Strat'!x)))"
     using 1(1,2) by(auto simp add: min_def take_Suc_conv_app_nth nth_append)
   have bb: "(drop (Suc l) (snd (Strat!x))) = (drop l (snd (?Strat'!x)))"
     using 1(1,2) by(auto simp add: min_def take_Suc_conv_app_nth nth_append )
  
   have "(swaps (snd (Strat ! x)) (steps init (take x qs) (take x Strat)))
       = (swaps (take l (snd (Strat ! x)) @ (snd (Strat ! x))!l # drop (Suc l) (snd (Strat ! x))) (steps init (take x qs) (take x Strat)))"
       unfolding id_take_nth_drop[OF 1(2), symmetric] by simp
   also have "...
       = (swaps (take l (snd (Strat ! x)) @ drop (Suc l) (snd (Strat ! x))) (steps init (take x qs) (take x Strat)))"
         using 1(3) by(simp add: swap_def steps_length)
   finally have noeffect: "(swaps (snd (Strat ! x)) (steps init (take x qs) (take x Strat)))
       = (swaps (take l (snd (Strat ! x)) @ drop (Suc l) (snd (Strat ! x))) (steps init (take x qs) (take x Strat)))"
       .
       
 
   have c: "t\<^sub>p (steps init (take x qs) (take x Strat)) (qs ! x) (Strat ! x) = 
         t\<^sub>p (steps init (take x qs) (take x ?Strat')) (qs ! x) (?Strat' ! x) + 1"
     unfolding a t\<^sub>p_def using 1(1,2)
     apply(simp add: min_def split_def nth_append) unfolding noeffect
     by(simp) 
 
   have "T\<^sub>p init (take (Suc x) qs) (take (Suc x) Strat)
         = T\<^sub>p init (take x qs) (take x ?Strat') + 
               t\<^sub>p (steps init (take x qs) (take x Strat)) (qs ! x) (Strat ! x)"
         using 1(1) a by(simp add: take_Suc_conv_app_nth T_append)
   also have "\<dots> = T\<^sub>p init (take x qs) (take x ?Strat')  + 
               t\<^sub>p (steps init (take x qs) (take x ?Strat')) (qs ! x) (?Strat' ! x) + 1"
               unfolding c by(simp)
   also have "\<dots> = T\<^sub>p init (take (Suc x) qs) (take (Suc x) ?Strat')  + 1"
         using 1(1) a by(simp add: min_def take_Suc_conv_app_nth T_append nth_append)
   finally have bef: "T\<^sub>p init (take (Suc x) qs) (take (Suc x) Strat)
       = T\<^sub>p init (take (Suc x) qs) (take (Suc x) ?Strat') + 1" .
      
   let ?interstate = "(steps init (take (Suc x) qs) (take (Suc x) Strat))"
   let ?interstate' = "(steps init (take (Suc x) qs) (take (Suc x) ?Strat'))"
 
   have state: "?interstate' = ?interstate"
     using 1(1) apply(simp add: take_Suc_conv_app_nth min_def)
     apply(simp add: steps_append step_def split_def) using noeffect by simp
 
 
   have "T\<^sub>p init qs Strat
       = T\<^sub>p init (take (Suc x) qs @ drop (Suc x) qs)  (take (Suc x) Strat @ drop (Suc x) Strat)"
         by simp
   also have "\<dots> = T\<^sub>p init (take (Suc x) qs) (take (Suc x) Strat)
             + T\<^sub>p ?interstate (drop (Suc x) qs) (drop (Suc x) Strat)"
               apply(subst T_append2) by(simp_all)
   also have "\<dots> =  T\<^sub>p init (take (Suc x) qs) (take (Suc x) ?Strat')
             + T\<^sub>p ?interstate' (drop (Suc x) qs) (drop (Suc x) ?Strat') + 1"
        unfolding bef state using 1(1) by(simp add: min_def nth_append)
   also have "\<dots> = T\<^sub>p init (take (Suc x) qs @ drop (Suc x) qs)  (take (Suc x) ?Strat' @ drop (Suc x) ?Strat') + 1"
               apply(subst T_append2) using 1(1) by(simp_all add: min_def)     
   also have "\<dots> = T\<^sub>p init qs ?Strat' + 1" by simp
   finally have better: "T\<^sub>p init qs ?Strat' + 1 = T\<^sub>p init qs Strat" by simp
 
   have "T\<^sub>p init qs ?Strat' + 1 = T\<^sub>p init qs Strat" by (fact better)
   also have "\<dots> = T\<^sub>p_opt init qs" by (fact opt)
   also from cInf_lower[OF isin] have "\<dots>  \<le>  T\<^sub>p init qs ?Strat'" unfolding T_opt_def by simp
   finally show "False" using init_nempty by auto
 qed
 
 
 (* Gleichung 1.8 in Borodin *)
 lemma umformung_OPT:
   assumes inlist: "set qs \<subseteq> set init"
   assumes dist: "distinct init" 
   assumes a: "T\<^sub>p_opt init qs = T\<^sub>p init qs Strat"
   assumes b: " length qs = length Strat"
   assumes c: "init\<noteq>[]"
   shows "T\<^sub>p_opt init qs = 
     (\<Sum>(x,y)\<in>{(x,y::('a::linorder)). x \<in> set init \<and> y\<in>set init \<and> x<y}.
           ALGxy_det Strat qs init x y + ALG_Pxy Strat qs init x y)"
 proof -
     have "T\<^sub>p_opt init qs = T\<^sub>p init qs Strat" by(fact a)
     also have "\<dots> =
     (\<Sum>(x,y)\<in>{(x,y::('a::linorder)). x \<in> set init \<and> y\<in>set init \<and> x<y}.
           ALGxy_det Strat qs init x y + ALG_Pxy Strat qs init x y)"
           apply(rule umformung_OPT')
             apply(fact)+
             using OPT_noStupid[OF b[symmetric] a[symmetric] c] apply(simp) done
     finally show ?thesis .
 qed
 
 
 corollary OPT_zerlegen: 
   assumes
         dist: "distinct init"
   and c: "init\<noteq>[]"
     and setqsinit: "set qs \<subseteq> set init"
   shows "(\<Sum>(x,y)\<in>{(x,y::('a::linorder)). x \<in> set init \<and> y\<in>set init \<and> x<y}. (T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y})))
         \<le> T\<^sub>p_opt init qs"
 proof -
 
     have "T\<^sub>p_opt init qs \<in> {T\<^sub>p init qs as |as. length as = length qs}"
     unfolding T_opt_def 
       apply(rule nn_contains_Inf)
       apply(auto) by (rule Ex_list_of_length)
 
     then obtain Strat where a: "T\<^sub>p init qs Strat = T\<^sub>p_opt init qs"
                        and b: "length Strat = length qs"
               unfolding T_opt_def by auto
 
   have "(\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
        T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x, y})) \<le> (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}.
           ALGxy_det Strat qs init x y + ALG_Pxy Strat qs init x y)"
      apply (rule sum_mono)
      apply(auto)
      proof goal_cases
        case (1 a b)
        then have "a\<noteq>b" by auto 
        show ?case apply(rule T1_7[OF a b]) by(fact)+
      qed
   also from umformung_OPT[OF setqsinit dist] a b c have "\<dots> = T\<^sub>p init qs Strat" by auto
   also from a have "\<dots> = T\<^sub>p_opt init qs" by simp
   finally show ?thesis .
 qed
 
 
 subsection "Factoring Lemma"
 
 
 lemma cardofpairs: "S \<noteq> [] \<Longrightarrow> sorted S \<Longrightarrow> distinct S \<Longrightarrow> card {(x,y). x \<in> set S \<and> y\<in>set S \<and> x<y} = ((length S)*(length S-1)) / 2"
 proof (induct S rule: list_nonempty_induct)
   case (cons s ss)
   then have "sorted ss" "distinct ss" by auto
   from cons(2)[OF this(1) this(2)] have iH: "card {(x, y) . x \<in> set ss \<and> y \<in> set ss \<and> x < y}
     = (length ss * (length ss-1)) / 2"
     by auto
 
   from cons have sss: "s \<notin> set ss" by auto
 
   from cons have tt: "(\<forall>y\<in>set (s#ss). s \<le> y)" by auto
   with cons  have tt': "(\<forall>y\<in>set ss. s < y)"
   proof -
     from sss have "(\<forall>y\<in>set ss. s \<noteq> y)" by auto
     with tt show ?thesis by fastforce
   qed
     
   then have "{(x, y) . x = s \<and> y \<in> set ss \<and> x < y}
           = {(x, y) . x = s \<and> y \<in> set ss}" by auto
   also have "\<dots> = {s}\<times>(set ss)" by auto
   finally have "{(x, y) . x = s \<and> y \<in> set ss \<and> x < y} = {s}\<times>(set ss)" .
   then have "card {(x, y) . x = s \<and> y \<in> set ss \<and> x < y}
           = card (set ss)" by(auto)
   also from cons distinct_card have "\<dots> = length ss" by auto
   finally have step: "card {(x, y) . x = s \<and> y \<in> set ss \<and> x < y} =
             length ss" .
 
   have uni: "{(x, y) . x \<in> set (s # ss) \<and> y \<in> set (s # ss) \<and> x < y}
       = {(x, y) . x \<in> set ss \<and> y \<in> set ss \<and> x < y}
         \<union> {(x, y) . x = s \<and> y \<in> set ss \<and> x < y}"
         using tt by auto
 
   have disj: "{(x, y) . x \<in> set ss \<and> y \<in> set ss \<and> x < y}
         \<inter> {(x, y) . x = s \<and> y \<in> set ss \<and> x < y} = {}"
           using sss by(auto)
   have "card {(x, y) . x \<in> set (s # ss) \<and> y \<in> set (s # ss) \<and> x < y}
     = card ({(x, y) . x \<in> set ss \<and> y \<in> set ss \<and> x < y}
         \<union> {(x, y) . x = s \<and> y \<in> set ss \<and> x < y})" using uni by auto
   also have "\<dots> = card {(x, y) . x \<in> set ss \<and> y \<in> set ss \<and> x < y}
           + card {(x, y) . x = s \<and> y \<in> set ss \<and> x < y}" 
        apply(rule card_Un_disjoint)
           apply(rule finite_subset[where B="(set ss) \<times> (set ss)"])
            apply(force)
           apply(simp)
          apply(rule finite_subset[where B="{s} \<times> (set ss)"])
           apply(force)
          apply(simp)
          using disj apply(simp) done
   also have "\<dots> = (length ss * (length ss-1)) / 2
                   + length ss" using iH step by auto
   also have "\<dots> = (length ss * (length ss-1) + 2*length ss) / 2" by auto
   also have "\<dots> = (length ss * (length ss-1) + length ss * 2) / 2" by auto
   also have "\<dots> = (length ss * (length ss-1+2)) / 2"
     by simp
   also have "\<dots> = (length ss * (length ss+1)) / 2"
     using cons(1) by simp
   also have "\<dots> = ((length ss+1) * length ss) / 2" by auto
   also have "\<dots> = (length (s#ss) * (length (s#ss)-1)) / 2" by auto
   finally show ?case by auto
 next
   case single thus ?case by(simp cong: conj_cong)
 qed
 
 
 (* factoring lemma *)
 lemma factoringlemma_withconstant:
     fixes A
           and b::real
           and c::real
       assumes c: "c \<ge> 1"
       assumes dist: "\<forall>e\<in>S0. distinct e"
       assumes notempty: "\<forall>e\<in>S0. length e > 0"
       (* A has pairwise property *)
       assumes pw: "pairwise A"
       (* A is c-competitive on list of length 2 *) 
       assumes on2: "\<forall>s0\<in>S0. \<exists>b\<ge>0. \<forall>qs\<in>{x. set x \<subseteq> set s0}. \<forall>(x,y)\<in>{(x,y). x \<in> set s0 \<and> y\<in>set s0 \<and> x<y}. T\<^sub>p_on_rand A (Lxy s0 {x,y}) (Lxy qs {x,y})  \<le> c * (T\<^sub>p_opt (Lxy s0 {x,y}) (Lxy qs {x,y})) + b" 
       assumes nopaid: "\<And>is s q. \<forall>((free,paid),_) \<in> (snd A (s, is) q). paid=[]"
       assumes 4: "\<And>init qs. distinct init \<Longrightarrow> set qs \<subseteq> set init \<Longrightarrow> (\<And>x. x<length qs \<Longrightarrow> finite (set_pmf (config'' A qs init x)))" 
       (* then A is c-competitive on arbitrary list lengths *)
       shows "\<forall>s0\<in>S0. \<exists>b\<ge>0.  \<forall>qs\<in>{x. set x \<subseteq> set s0}. 
               T\<^sub>p_on_rand A s0 qs \<le> c * real (T\<^sub>p_opt s0 qs) + b"
 proof (standard, goal_cases)
   case (1 init)
     have d: "distinct init" using  dist 1 by auto
     have d2: "init \<noteq> []" using  notempty 1 by auto
 
 
     obtain b where on3: "\<forall>qs\<in>{x. set x \<subseteq> set init}. \<forall>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. T\<^sub>p_on_rand A  (Lxy init {x,y}) (Lxy qs {x,y}) \<le> c * (T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y})) + b"
         and b: "b\<ge>0"
       using on2 1 by auto
 
   {
 
     fix qs
     assume drin: "set qs \<subseteq> set init"
 
   have "T\<^sub>p_on_rand A init qs =
 (\<Sum>(x,y)\<in>{(x, y) . x \<in> set init \<and> y \<in> set init \<and> x < y}.
        T\<^sub>p_on_rand A (Lxy init {x,y}) (Lxy qs {x, y})) "
        apply(rule umf_pair)
         apply(fact)+
         using 4[of init qs] drin d by(simp add: split_def)
        (* 1.4 *) 
   also have "\<dots> \<le> (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. c * (T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y})) + b)"
         apply(rule sum_mono)
         using on3 drin by(simp add: split_def) 
   also have "\<dots> = c * (\<Sum>(x,y)\<in>{(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y}. T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x,y})) + b*(((length init)*(length init-1)) / 2)"
   proof - 
 
     {
       fix S::"'a list"
       assume dis: "distinct S"
       assume d2: "S \<noteq> []"
       then have d3: "sort S \<noteq> []" by (metis length_0_conv length_sort)
       have "card {(x,y). x \<in> set S \<and> y\<in>set S \<and> x<y}
             = card {(x,y). x \<in> set (sort S) \<and> y\<in>set (sort S) \<and> x<y}"
             by auto
       also have "\<dots> = (length (sort S) * (length (sort S) - 1)) / 2"
         apply(rule cardofpairs) using dis d2 d3 by (simp_all)
       finally have "card {(x, y) . x \<in> set S \<and> y \<in> set S \<and> x < y} =
               (length (sort S) * (length (sort S) - 1)) / 2 " .      
     }
     with d d2 have e: "card {(x,y). x \<in> set init \<and> y\<in>set init \<and> x<y} = ((length init)*(length init-1)) / 2" by auto
     show ?thesis  (is "(\<Sum>(x,y)\<in>?S. c * (?T x y) + b) = c * ?R + b*?T2")
     proof -
        have "(\<Sum>(x,y)\<in>?S. c * (?T x y) + b) =
               c * (\<Sum>(x,y)\<in>?S. (?T x y)) + (\<Sum>(x,y)\<in>?S. b)"
               by(simp add: split_def sum.distrib sum_distrib_left)
        also have "\<dots> = c * (\<Sum>(x,y)\<in>?S. (?T x y)) + b*?T2"
           using e by(simp add: split_def)
        finally show ?thesis by(simp add: split_def)
     qed
   qed
   also have "\<dots> \<le> c * T\<^sub>p_opt init qs + (b*((length init)*(length init-1)) / 2)"
     proof -
       have "(\<Sum>(x, y)\<in>{(x, y) . x \<in> set init \<and>
               y \<in> set init \<and> x < y}. T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x, y}))
               \<le>  T\<^sub>p_opt init qs"
               using OPT_zerlegen drin d d2 by auto    
       then have "  real (\<Sum>(x, y)\<in>{(x, y) . x \<in> set init \<and>
               y \<in> set init \<and> x < y}. T\<^sub>p_opt (Lxy init {x,y}) (Lxy qs {x, y}))
               \<le>    (T\<^sub>p_opt init qs)"
                   by linarith
       with c show ?thesis by(auto simp: split_def)
     qed
   finally have f: "T\<^sub>p_on_rand A init qs \<le> c * real (T\<^sub>p_opt init qs) + (b*((length init)*(length init-1)) / 2)" .
   } note all=this
   show ?case unfolding compet_def
     apply(auto)
       apply(rule exI[where x="(b*((length init)*(length init-1)) / 2)"])
       apply(safe)
         using notempty 1 b apply simp
         using all b by simp
 qed
 
 lemma factoringlemma_withconstant':
     fixes A
           and b::real
           and c::real
       assumes c: "c \<ge> 1"
       assumes dist: "\<forall>e\<in>S0. distinct e"
       assumes notempty: "\<forall>e\<in>S0. length e > 0"
       (* A has pairwise property *)
       assumes pw: "pairwise A"
       (* A is c-competitive on list of length 2 *) 
       assumes on2: "\<forall>s0\<in>S0. \<exists>b\<ge>0. \<forall>qs\<in>{x. set x \<subseteq> set s0}. \<forall>(x,y)\<in>{(x,y). x \<in> set s0 \<and> y\<in>set s0 \<and> x<y}. T\<^sub>p_on_rand A (Lxy s0 {x,y}) (Lxy qs {x,y})  \<le> c * (T\<^sub>p_opt (Lxy s0 {x,y}) (Lxy qs {x,y})) + b" 
       assumes nopaid: "\<And>is s q. \<forall>((free,paid),_) \<in> (snd A (s, is) q). paid=[]"
       assumes 4: "\<And>init qs. distinct init \<Longrightarrow> set qs \<subseteq> set init \<Longrightarrow> (\<And>x. x<length qs \<Longrightarrow> finite (set_pmf (config'' A qs init x)))" 
       (* then A is c-competitive on arbitrary list lengths *)
       shows "compet_rand A c S0"
 unfolding compet_rand_def static_def using factoringlemma_withconstant[OF assms] by simp
 
  
 end
diff --git a/thys/MFMC_Countable/MFMC_Flow_Attainability.thy b/thys/MFMC_Countable/MFMC_Flow_Attainability.thy
--- a/thys/MFMC_Countable/MFMC_Flow_Attainability.thy
+++ b/thys/MFMC_Countable/MFMC_Flow_Attainability.thy
@@ -1,2166 +1,2166 @@
 theory MFMC_Flow_Attainability imports
   MFMC_Network
 begin
 
 section \<open>Attainability of flows in networks\<close>
 
 subsection \<open>Cleaning up flows\<close>
 
 text \<open>If there is a flow along antiparallel edges, it suffices to consider the difference.\<close>
 
 definition cleanup :: "'a flow \<Rightarrow> 'a flow"
 where "cleanup f = (\<lambda>(a, b). if f (a, b) > f (b, a) then f (a, b) - f (b, a) else 0)"
 
 lemma cleanup_simps [simp]:
   "cleanup f (a, b) = (if f (a, b) > f (b, a) then f (a, b) - f (b, a) else 0)"
 by(simp add: cleanup_def)
 
 lemma value_flow_cleanup:
   assumes [simp]: "\<And>x. f (x, source \<Delta>) = 0"
   shows "value_flow \<Delta> (cleanup f) = value_flow \<Delta> f"
 unfolding d_OUT_def
 by (auto simp add: not_less intro!: nn_integral_cong intro: antisym)
 
 lemma KIR_cleanup:
   assumes KIR: "KIR f x"
   and finite_IN: "d_IN f x \<noteq> \<top>"
   shows "KIR (cleanup f) x"
 proof -
   from finite_IN KIR have finite_OUT: "d_OUT f x \<noteq> \<top>" by simp
 
   have finite_IN: "(\<Sum>\<^sup>+ y\<in>A. f (y, x)) \<noteq> \<top>" for A
     using finite_IN by(rule neq_top_trans)(auto simp add: d_IN_def nn_integral_count_space_indicator intro!: nn_integral_mono split: split_indicator)
   have finite_OUT: "(\<Sum>\<^sup>+ y\<in>A. f (x, y)) \<noteq> \<top>" for A
     using finite_OUT by(rule neq_top_trans)(auto simp add: d_OUT_def nn_integral_count_space_indicator intro!: nn_integral_mono split: split_indicator)
   have finite_in: "f (x, y) \<noteq> \<top>" for y using \<open>d_OUT f x \<noteq> \<top>\<close>
     by(rule neq_top_trans) (rule d_OUT_ge_point)
 
   let ?M = "{y. f (x, y) > f (y, x)}"
 
   have "d_OUT (cleanup f) x = (\<Sum>\<^sup>+ y\<in>?M. f (x, y) - f (y, x))"
     by(auto simp add: d_OUT_def nn_integral_count_space_indicator intro!: nn_integral_cong)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>?M. f (x, y)) - (\<Sum>\<^sup>+ y\<in>?M. f (y, x))" using finite_IN
     by(subst nn_integral_diff)(auto simp add: AE_count_space)
   also have "\<dots> = (d_OUT f x - (\<Sum>\<^sup>+ y\<in>{y. f (x, y) \<le> f (y, x)}. f (x, y))) - (\<Sum>\<^sup>+ y\<in>?M. f (y, x))"
     unfolding d_OUT_def d_IN_def using finite_IN finite_OUT
     apply(simp add: nn_integral_count_space_indicator)
     apply(subst (2) nn_integral_diff[symmetric])
     apply(auto simp add: AE_count_space finite_in split: split_indicator intro!: arg_cong2[where f="(-)"] intro!: nn_integral_cong)
     done
   also have "\<dots> = (d_IN f x - (\<Sum>\<^sup>+ y\<in>?M. f (y, x))) - (\<Sum>\<^sup>+ y\<in>{y. f (x, y) \<le> f (y, x)}. f (x, y))"
     using KIR by(simp add: diff_diff_commute_ennreal)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>{y. f (x, y) \<le> f (y, x)}. f (y, x)) - (\<Sum>\<^sup>+ y\<in>{y. f (x, y) \<le> f (y, x)}. f (x, y))"
     using finite_IN finite_IN[of "{ _ }"]
     apply(simp add: d_IN_def nn_integral_count_space_indicator)
     apply(subst nn_integral_diff[symmetric])
     apply(auto simp add: d_IN_def AE_count_space split: split_indicator intro!: arg_cong2[where f="(-)"] intro!: nn_integral_cong)
     done
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>{y. f (x, y) \<le> f (y, x)}. f (y, x) - f (x, y))" using finite_OUT
     by(subst nn_integral_diff)(auto simp add: AE_count_space)
   also have "\<dots> = d_IN (cleanup f) x" using finite_in
     by(auto simp add: d_IN_def nn_integral_count_space_indicator intro!: ennreal_diff_self nn_integral_cong split: split_indicator)
   finally show "KIR (cleanup f) x" .
 qed
 
 locale flow_attainability = countable_network \<Delta>
   for \<Delta> :: "('v, 'more) network_scheme" (structure)
   +
   assumes finite_capacity: "\<And>x. x \<noteq> sink \<Delta> \<Longrightarrow> d_IN (capacity \<Delta>) x \<noteq> \<top> \<or> d_OUT (capacity \<Delta>) x \<noteq> \<top>"
   and no_loop: "\<And>x. \<not> edge \<Delta> x x"
   and source_in: "\<And>x. \<not> edge \<Delta> x (source \<Delta>)"
 begin
 
 lemma source_in_not_cycle:
   assumes "cycle \<Delta> p"
   shows "(x, source \<Delta>) \<notin> set (cycle_edges p)"
 using cycle_edges_edges[OF assms] source_in[of x] by(auto)
 
 lemma source_out_not_cycle:
   "cycle \<Delta> p \<Longrightarrow> (source \<Delta>, x) \<notin> set (cycle_edges p)"
 by(auto dest: cycle_leave_ex_enter source_in_not_cycle)
 
 lemma flowD_source_IN:
   assumes "flow \<Delta> f"
   shows "d_IN f (source \<Delta>) = 0"
 proof -
   have "d_IN f (source \<Delta>) = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N (source \<Delta>). f (y, source \<Delta>))"
     by(rule d_IN_alt_def)(simp add: flowD_outside[OF assms])
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N (source \<Delta>). 0)"
     by(rule nn_integral_cong)(simp add: source_in incoming_def)
   finally show ?thesis by simp
 qed
 
 lemma flowD_finite_IN:
   assumes f: "flow \<Delta> f" and x: "x \<noteq> sink \<Delta>"
   shows "d_IN f x \<noteq> top"
 proof(cases "x = source \<Delta>")
   case True thus ?thesis by(simp add: flowD_source_IN[OF f])
 next
   case False
   from finite_capacity[OF x] show ?thesis
   proof
     assume *: "d_IN (capacity \<Delta>) x \<noteq> \<top>"
     from flowD_capacity[OF f] have "d_IN f x \<le> d_IN (capacity \<Delta>) x" by(rule d_IN_mono)
     also have "\<dots> < \<top>" using * by (simp add: less_top)
     finally show ?thesis by simp
   next
     assume *: "d_OUT (capacity \<Delta>) x \<noteq> \<top>"
     have "d_IN f x = d_OUT f x" using flowD_KIR[OF f False x] by simp
     also have "\<dots> \<le> d_OUT (capacity \<Delta>) x" using flowD_capacity[OF f] by(rule d_OUT_mono)
     also have "\<dots> < \<top>" using * by (simp add: less_top)
     finally show ?thesis by simp
   qed
 qed
 
 lemma flowD_finite_OUT:
   assumes "flow \<Delta> f" "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   shows "d_OUT f x \<noteq> \<top>"
 using flowD_KIR[OF assms] assms by(simp add: flowD_finite_IN)
 
 end
 
 locale flow_network = flow_attainability
   +
   fixes g :: "'v flow"
   assumes g: "flow \<Delta> g"
   and g_finite: "value_flow \<Delta> g \<noteq> \<top>"
   and nontrivial: "\<^bold>V - {source \<Delta>, sink \<Delta>} \<noteq> {}"
 begin
 
 lemma g_outside: "e \<notin> \<^bold>E \<Longrightarrow> g e = 0"
 by(rule flowD_outside)(rule g)
 
 lemma g_loop [simp]: "g (x, x) = 0"
 by(rule g_outside)(simp add: no_loop)
 
 lemma finite_IN_g: "x \<noteq> sink \<Delta> \<Longrightarrow> d_IN g x \<noteq> top"
 by(rule flowD_finite_IN[OF g])
 
 lemma finite_OUT_g:
   assumes "x \<noteq> sink \<Delta>"
   shows "d_OUT g x \<noteq> top"
 proof(cases "x = source \<Delta>")
   case True
   with g_finite show ?thesis by simp
 next
   case False
   with g have "KIR g x" using assms by(auto dest: flowD_KIR)
   with finite_IN_g[of x] False assms show ?thesis by(simp)
 qed
 
 lemma g_source_in [simp]: "g (x, source \<Delta>) = 0"
 by(rule g_outside)(simp add: source_in)
 
 lemma finite_g [simp]: "g e \<noteq> top"
   by(rule flowD_finite[OF g])
 
 
 definition enum_v :: "nat \<Rightarrow> 'v"
 where "enum_v n = from_nat_into (\<^bold>V - {source \<Delta>, sink \<Delta>}) (fst (prod_decode n))"
 
 lemma range_enum_v: "range enum_v \<subseteq> \<^bold>V - {source \<Delta>, sink \<Delta>}"
 using from_nat_into[OF nontrivial] by(auto simp add: enum_v_def)
 
 lemma enum_v_repeat:
   assumes x: "x \<in> \<^bold>V" "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   shows "\<exists>i'>i. enum_v i' = x"
 proof -
   let ?V = "\<^bold>V - {source \<Delta>, sink \<Delta>}"
   let ?n = "to_nat_on ?V x"
   let ?A = "{?n} \<times> (UNIV :: nat set)"
   from x have x': "x \<in> \<^bold>V - {source \<Delta>, sink \<Delta>}" by simp
   have "infinite ?A" by(auto dest: finite_cartesian_productD2)
   hence "infinite (prod_encode ` ?A)" by(auto dest: finite_imageD simp add: inj_prod_encode)
   then obtain i' where "i' > i" "i' \<in> prod_encode ` ?A"
     unfolding infinite_nat_iff_unbounded by blast
   from this(2) have "enum_v i' = x" using x by(clarsimp simp add: enum_v_def)
   with \<open>i' > i\<close> show ?thesis by blast
 qed
 
 fun h_plus :: "nat \<Rightarrow> 'v edge \<Rightarrow> ennreal"
 where
   "h_plus 0 (x, y) = (if x = source \<Delta> then g (x, y) else 0)"
 | "h_plus (Suc i) (x, y) =
   (if enum_v (Suc i) = x \<and> d_OUT (h_plus i) x < d_IN (h_plus i) x then
    let total = d_IN (h_plus i) x - d_OUT (h_plus i) x;
        share = g (x, y) - h_plus i (x, y);
        shares = d_OUT g x - d_OUT (h_plus i) x
    in h_plus i (x, y) + share * total / shares
    else h_plus i (x, y))"
 
 
 lemma h_plus_le_g: "h_plus i e \<le> g e"
 proof(induction i arbitrary: e and e)
   case 0 thus ?case by(cases e) simp
 next
   case (Suc i)
   { fix x y
     assume enum: "x = enum_v (Suc i)"
     assume less: "d_OUT (h_plus i) x < d_IN (h_plus i) x"
     from enum have x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>" using range_enum_v
       by(auto dest: sym intro: rev_image_eqI)
 
     define share where "share = g (x, y) - h_plus i (x, y)"
     define shares where "shares = d_OUT g x - d_OUT (h_plus i) x"
     define total where "total = d_IN (h_plus i) x - d_OUT (h_plus i) x"
     let ?h = "h_plus i (x, y) + share * total / shares"
 
     have "d_OUT (h_plus i) x \<le> d_OUT g x" by(rule d_OUT_mono)(rule Suc.IH)
     also have "\<dots> < top" using finite_OUT_g[of x] x by (simp add: less_top)
     finally have "d_OUT (h_plus i) x \<noteq> \<top>" by simp
     then have shares_eq: "shares = (\<Sum>\<^sup>+ y. g (x, y) - h_plus i (x, y))" unfolding shares_def d_OUT_def
       by(subst nn_integral_diff)(simp_all add: AE_count_space Suc.IH)
 
     have *: "share / shares \<le> 1"
     proof (cases "share = 0")
       case True thus ?thesis by(simp)
     next
       case False
       hence "share > 0" using \<open>h_plus i (x, y) \<le> g _\<close>
         by(simp add: share_def dual_order.strict_iff_order)
       moreover have "share \<le> shares" unfolding share_def shares_eq by(rule nn_integral_ge_point)simp
       ultimately show ?thesis by(simp add: divide_le_posI_ennreal)
     qed
 
     note shares_def
     also have "d_OUT g x = d_IN g x" by(rule flowD_KIR[OF g x])
     also have "d_IN (h_plus i) x \<le> d_IN g x" by(rule d_IN_mono)(rule Suc.IH)
     ultimately have *: "total \<le> shares" unfolding total_def by(simp add: ennreal_minus_mono)
     moreover have "total > 0" unfolding total_def using less by (clarsimp simp add: diff_gr0_ennreal)
     ultimately have "total / shares \<le> 1" by(intro divide_le_posI_ennreal)(simp_all)
     hence "share * (total / shares) \<le> share * 1"
       by(rule mult_left_mono) simp
     hence "?h \<le> h_plus i (x, y) + share" by(simp add: ennreal_times_divide add_mono)
     also have "\<dots> = g (x, y)" unfolding share_def using \<open>h_plus i (x, y) \<le> g _\<close> finite_g[of "(x, y)"]
       by simp
     moreover
     note calculation }
   note * = this
   show ?case using Suc.IH * by(cases e) clarsimp
 qed
 
 lemma h_plus_outside: "e \<notin> \<^bold>E \<Longrightarrow> h_plus i e = 0"
 by (metis g_outside h_plus_le_g le_zero_eq)
 
 lemma h_plus_not_infty [simp]: "h_plus i e \<noteq> top"
 using h_plus_le_g[of i e] by (auto simp: top_unique)
 
 lemma h_plus_mono: "h_plus i e \<le> h_plus (Suc i) e"
 proof(cases e)
   case [simp]: (Pair x y)
   { assume "d_OUT (h_plus i) x < d_IN (h_plus i) x"
     hence "h_plus i (x, y) + 0 \<le> h_plus i (x, y) + (g (x, y) - h_plus i (x, y)) * (d_IN (h_plus i) x - d_OUT (h_plus i) x) / (d_OUT g x - d_OUT (h_plus i) x)"
       by(intro add_left_mono d_OUT_mono le_funI) (simp_all add: h_plus_le_g) }
   then show ?thesis by clarsimp
 qed
 
 lemma h_plus_mono': "i \<le> j \<Longrightarrow> h_plus i e \<le> h_plus j e"
 by(induction rule: dec_induct)(auto intro: h_plus_mono order_trans)
 
 lemma d_OUT_h_plus_not_infty': "x \<noteq> sink \<Delta> \<Longrightarrow> d_OUT (h_plus i) x \<noteq> top"
 using d_OUT_mono[of "h_plus i" x g, OF h_plus_le_g] finite_OUT_g[of x] by (auto simp: top_unique)
 
 lemma h_plus_OUT_le_IN:
   assumes "x \<noteq> source \<Delta>"
   shows "d_OUT (h_plus i) x \<le> d_IN (h_plus i) x"
 proof(induction i)
   case 0
   thus ?case using assms by(simp add: d_OUT_def)
 next
   case (Suc i)
   have "d_OUT (h_plus (Suc i)) x \<le> d_IN (h_plus i) x"
   proof(cases "enum_v (Suc i) = x \<and> d_OUT (h_plus i) x < d_IN (h_plus i) x")
     case False
     thus ?thesis using Suc.IH by(simp add: d_OUT_def cong: conj_cong)
   next
     case True
     hence x: "x \<noteq> sink \<Delta>" and le: "d_OUT (h_plus i) x < d_IN (h_plus i) x" using range_enum_v by auto
     let ?r = "\<lambda>y. (g (x, y) - h_plus i (x, y)) * (d_IN (h_plus i) x - d_OUT (h_plus i) x) / (d_OUT g x - d_OUT (h_plus i) x)"
     have "d_OUT (h_plus (Suc i)) x = d_OUT (h_plus i) x + (\<Sum>\<^sup>+ y. ?r y)"
       using True unfolding d_OUT_def h_plus.simps by(simp add: AE_count_space nn_integral_add)
     also from True have "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>" using range_enum_v by auto
     from flowD_KIR[OF g this] le d_IN_mono[of "h_plus i" x g, OF h_plus_le_g]
     have le': "d_OUT (h_plus i) x < d_OUT g x" by(simp)
     then have "(\<Sum>\<^sup>+ y. ?r y) =
       (d_IN (h_plus i) x - d_OUT (h_plus i) x) * ((\<Sum>\<^sup>+ y. g (x, y) - h_plus i (x, y)) / (d_OUT g x - d_OUT (h_plus i) x))"
       by(subst mult.commute, subst ennreal_times_divide[symmetric])
         (simp add: nn_integral_cmult nn_integral_divide Suc.IH diff_gr0_ennreal)
     also have "(\<Sum>\<^sup>+ y. g (x, y) - h_plus i (x, y)) = d_OUT g x - d_OUT (h_plus i) x" using x
       by(subst nn_integral_diff)(simp_all add: d_OUT_def[symmetric] h_plus_le_g d_OUT_h_plus_not_infty')
     also have "\<dots> / \<dots> = 1" using le' finite_OUT_g[of x] x
       by(auto intro!: ennreal_divide_self dest: diff_gr0_ennreal simp: less_top[symmetric])
     also have "d_OUT (h_plus i) x + (d_IN (h_plus i) x - d_OUT (h_plus i) x) * 1 = d_IN (h_plus i) x" using x
       by (simp add: Suc)
     finally show ?thesis by simp
   qed
   also have "\<dots> \<le> d_IN (h_plus (Suc i)) x" by(rule d_IN_mono)(rule h_plus_mono)
   finally show ?case .
 qed
 
 lemma h_plus_OUT_eq_IN:
   assumes enum: "enum_v (Suc i) = x"
   shows "d_OUT (h_plus (Suc i)) x = d_IN (h_plus i) x"
 proof(cases "d_OUT (h_plus i) x < d_IN (h_plus i) x")
   case False
   from enum have "x \<noteq> source \<Delta>" using range_enum_v by auto
   from h_plus_OUT_le_IN[OF this, of i] False have "d_OUT (h_plus i) x = d_IN (h_plus i) x" by auto
   with False enum show ?thesis by(simp add: d_OUT_def)
 next
   case True
   from enum have x: "x \<noteq> source \<Delta>" and sink: "x \<noteq> sink \<Delta>" using range_enum_v by auto
   let ?r = "\<lambda>y. (g (x, y) - h_plus i (x, y)) * (d_IN (h_plus i) x - d_OUT (h_plus i) x) / (d_OUT g x - d_OUT (h_plus i) x)"
   have "d_OUT (h_plus (Suc i)) x = d_OUT (h_plus i) x + (\<Sum>\<^sup>+ y. ?r y)"
     using True enum unfolding d_OUT_def h_plus.simps by(simp add: AE_count_space nn_integral_add)
   also from True enum have "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>" using range_enum_v by auto
   from flowD_KIR[OF g this] True d_IN_mono[of "h_plus i" x g, OF h_plus_le_g]
   have le': "d_OUT (h_plus i) x < d_OUT g x" by(simp)
   then have "(\<Sum>\<^sup>+ y. ?r y ) =
     (d_IN (h_plus i) x - d_OUT (h_plus i) x) * ((\<Sum>\<^sup>+ y. g (x, y) - h_plus i (x, y)) / (d_OUT g x - d_OUT (h_plus i) x))"
     by(subst mult.commute, subst ennreal_times_divide[symmetric])
       (simp add: nn_integral_cmult nn_integral_divide h_plus_OUT_le_IN[OF x] diff_gr0_ennreal)
   also have "(\<Sum>\<^sup>+ y. g (x, y) - h_plus i (x, y)) = d_OUT g x - d_OUT (h_plus i) x" using sink
     by(subst nn_integral_diff)(simp_all add: d_OUT_def[symmetric] h_plus_le_g d_OUT_h_plus_not_infty')
   also have "\<dots> / \<dots> = 1" using le' finite_OUT_g[of x] sink
     by(auto intro!: ennreal_divide_self dest: diff_gr0_ennreal simp: less_top[symmetric])
   also have "d_OUT (h_plus i) x + (d_IN (h_plus i) x - d_OUT (h_plus i) x) * 1 = d_IN (h_plus i) x" using sink
     by (simp add: h_plus_OUT_le_IN x)
   finally show ?thesis .
 qed
 
 lemma h_plus_source_in [simp]: "h_plus i (x, source \<Delta>) = 0"
 by(induction i)simp_all
 
 lemma h_plus_sum_finite: "(\<Sum>\<^sup>+ e. h_plus i e) \<noteq> top"
 proof(induction i)
   case 0
   have "(\<Sum>\<^sup>+ e\<in>UNIV. h_plus 0 e) = (\<Sum>\<^sup>+ (x, y). h_plus 0 (x, y))"
     by(simp del: h_plus.simps)
   also have "\<dots> = (\<Sum>\<^sup>+ (x, y)\<in>range (Pair (source \<Delta>)). h_plus 0 (x, y))"
     by(auto simp add: nn_integral_count_space_indicator intro!: nn_integral_cong)
   also have "\<dots> = value_flow \<Delta> g" by(simp add: d_OUT_def nn_integral_count_space_reindex)
   also have "\<dots> < \<top>" using g_finite by (simp add: less_top)
   finally show ?case by simp
 next
   case (Suc i)
   define xi where "xi = enum_v (Suc i)"
   then have xi: "xi \<noteq> source \<Delta>" "xi \<noteq> sink \<Delta>" using range_enum_v by auto
   show ?case
   proof(cases "d_OUT (h_plus i) xi < d_IN (h_plus i) xi")
     case False
     hence "(\<Sum>\<^sup>+ e\<in>UNIV. h_plus (Suc i) e) = (\<Sum>\<^sup>+ e. h_plus i e)"
       by(auto intro!: nn_integral_cong simp add: xi_def)
     with Suc.IH show ?thesis by simp
   next
     case True
     have less: "d_OUT (h_plus i) xi < d_OUT g xi"
       using True flowD_KIR[OF g xi] d_IN_mono[of "h_plus i" xi, OF h_plus_le_g]
       by simp
 
     have "(\<Sum>\<^sup>+ e. h_plus (Suc i) e) =
       (\<Sum>\<^sup>+ e\<in>UNIV. h_plus i e) + (\<Sum>\<^sup>+ (x, y). ((g (x, y) - h_plus i (x, y)) * (d_IN (h_plus i) x - d_OUT (h_plus i) x) / (d_OUT g x - d_OUT (h_plus i) x)) * indicator (range (Pair xi)) (x, y))"
       (is "_ = ?IH + ?rest" is "_ = _ + \<integral>\<^sup>+ (x, y). ?f x y * _ \<partial>_") using xi True
       by(subst nn_integral_add[symmetric])(auto simp add: xi_def split_beta AE_count_space intro!: nn_integral_cong split: split_indicator intro!: h_plus_le_g h_plus_OUT_le_IN d_OUT_mono le_funI)
     also have "?rest = (\<Sum>\<^sup>+ (x, y)\<in>range (Pair xi). ?f x y)"
       by(simp add: nn_integral_count_space_indicator split_def)
     also have "\<dots> = (\<Sum>\<^sup>+ y. ?f xi y)" by(simp add: nn_integral_count_space_reindex)
     also have "\<dots> = (\<Sum>\<^sup>+ y. g (xi, y) - h_plus i (xi, y)) * ((d_IN (h_plus i) xi - d_OUT (h_plus i) xi) / (d_OUT g xi - d_OUT (h_plus i) xi))"
       (is "_ = ?integral * ?factor")  using True less
       by(simp add: nn_integral_multc nn_integral_divide diff_gr0_ennreal ennreal_times_divide)
     also have "?integral = d_OUT g xi - d_OUT (h_plus i) xi" unfolding d_OUT_def using xi
       by(subst nn_integral_diff)(simp_all add: h_plus_le_g d_OUT_def[symmetric] d_OUT_h_plus_not_infty')
     also have "\<dots> * ?factor = (d_IN (h_plus i) xi - d_OUT (h_plus i) xi)" using xi
       apply (subst ennreal_times_divide)
       apply (subst mult.commute)
       apply (subst ennreal_mult_divide_eq)
       apply (simp_all add: diff_gr0_ennreal finite_OUT_g less zero_less_iff_neq_zero[symmetric])
       done
     also have "\<dots> \<noteq> \<top>" using h_plus_OUT_eq_IN[OF refl, of i, folded xi_def, symmetric] xi
       by(simp add: d_OUT_h_plus_not_infty')
     ultimately show ?thesis using Suc.IH by simp
   qed
 qed
 
 lemma d_OUT_h_plus_not_infty [simp]: "d_OUT (h_plus i) x \<noteq> top"
 proof -
   have "d_OUT (h_plus i) x \<le> (\<Sum>\<^sup>+ y\<in>UNIV. \<Sum>\<^sup>+ x. h_plus i (x, y))"
     unfolding d_OUT_def by(rule nn_integral_mono nn_integral_ge_point)+ simp
   also have "\<dots> < \<top>" using h_plus_sum_finite by(simp add: nn_integral_snd_count_space less_top)
   finally show ?thesis by simp
 qed
 
 definition enum_cycle :: "nat \<Rightarrow> 'v path"
 where "enum_cycle = from_nat_into (cycles \<Delta>)"
 
 lemma cycle_enum_cycle [simp]: "cycles \<Delta> \<noteq> {} \<Longrightarrow> cycle \<Delta> (enum_cycle n)"
 unfolding enum_cycle_def using from_nat_into[of "cycles \<Delta>" n] by simp
 
 context
   fixes h' :: "'v flow"
   assumes finite_h': "h' e \<noteq> top"
 begin
 
 fun h_minus_aux :: "nat \<Rightarrow> 'v edge \<Rightarrow> ennreal"
 where
   "h_minus_aux 0 e = 0"
 | "h_minus_aux (Suc j) e =
   (if e \<in> set (cycle_edges (enum_cycle j)) then
      h_minus_aux j e + Min {h' e' - h_minus_aux j e'|e'. e'\<in>set (cycle_edges (enum_cycle j))}
    else h_minus_aux j e)"
 
 lemma h_minus_aux_le_h': "h_minus_aux j e \<le> h' e"
 proof(induction j e rule: h_minus_aux.induct)
   case 0: (1 e) show ?case by simp
 next
   case Suc: (2 j e)
   { assume e: "e \<in> set (cycle_edges (enum_cycle j))"
     then have "h_minus_aux j e + Min {h' e' - h_minus_aux j e' |e'. e' \<in> set (cycle_edges (enum_cycle j))} \<le>
       h_minus_aux j e + (h' e - h_minus_aux j e)"
       using [[simproc add: finite_Collect]] by(cases e rule: prod.exhaust)(auto intro!: add_mono Min_le)
     also have "\<dots> = h' e" using e finite_h'[of e] Suc.IH(2)[of e]
       by(cases e rule: prod.exhaust)
         (auto simp add: add_diff_eq_ennreal top_unique intro!: ennreal_add_diff_cancel_left)
     also note calculation }
   then show ?case using Suc by clarsimp
 qed
 
 lemma h_minus_aux_finite [simp]: "h_minus_aux j e \<noteq> top"
 using h_minus_aux_le_h'[of j e] finite_h'[of e] by (auto simp: top_unique)
 
 lemma h_minus_aux_mono: "h_minus_aux j e \<le> h_minus_aux (Suc j) e"
 proof(cases "e \<in> set (cycle_edges (enum_cycle j)) = True")
   case True
   have "h_minus_aux j e + 0 \<le> h_minus_aux (Suc j) e" unfolding h_minus_aux.simps True if_True
     using True [[simproc add: finite_Collect]]
     by(cases e)(rule add_mono, auto intro!: Min.boundedI simp add: h_minus_aux_le_h')
   thus ?thesis by simp
 qed simp
 
 lemma d_OUT_h_minus_aux:
   assumes "cycles \<Delta> \<noteq> {}"
   shows "d_OUT (h_minus_aux j) x = d_IN (h_minus_aux j) x"
 proof(induction j)
   case 0 show ?case by simp
 next
   case (Suc j)
   define C where "C = enum_cycle j"
   define \<delta> where "\<delta> = Min {h' e' - h_minus_aux j e' |e'. e' \<in> set (cycle_edges C)}"
 
   have "d_OUT (h_minus_aux (Suc j)) x =
     (\<Sum>\<^sup>+ y. h_minus_aux j (x, y) + (if (x, y) \<in> set (cycle_edges C) then \<delta> else 0))"
     unfolding d_OUT_def by(simp add: if_distrib C_def \<delta>_def cong del: if_weak_cong)
   also have "\<dots> = d_OUT (h_minus_aux j) x + (\<Sum>\<^sup>+ y. \<delta> * indicator (set (cycle_edges C)) (x, y))"
     (is "_ = _ + ?add")
     by(subst nn_integral_add)(auto simp add: AE_count_space d_OUT_def intro!: arg_cong2[where f="(+)"] nn_integral_cong)
   also have "?add = (\<Sum>\<^sup>+ e\<in>range (Pair x). \<delta> * indicator {(x', y). (x', y) \<in> set (cycle_edges C) \<and> x' = x} e)"
     by(auto simp add: nn_integral_count_space_reindex intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = \<delta> * card (set (filter (\<lambda>(x', y). x' = x) (cycle_edges C)))"
     using [[simproc add: finite_Collect]]
     apply(subst nn_integral_cmult_indicator; auto)
     apply(subst emeasure_count_space; auto simp add: split_def)
     done
   also have "card (set (filter (\<lambda>(x', y). x' = x) (cycle_edges C))) = card (set (filter (\<lambda>(x', y). y = x) (cycle_edges C)))"
     unfolding C_def by(rule cycle_enter_leave_same)(rule cycle_enum_cycle[OF assms])
   also have "\<delta> * \<dots> =  (\<Sum>\<^sup>+ e\<in>range (\<lambda>x'. (x', x)). \<delta> * indicator {(x', y). (x', y) \<in> set (cycle_edges C) \<and> y = x} e)"
     using [[simproc add: finite_Collect]]
     apply(subst nn_integral_cmult_indicator; auto)
     apply(subst emeasure_count_space; auto simp add: split_def)
     done
   also have "\<dots> = (\<Sum>\<^sup>+ x'. \<delta> * indicator (set (cycle_edges C)) (x', x))"
     by(auto simp add: nn_integral_count_space_reindex intro!: nn_integral_cong split: split_indicator)
   also have "d_OUT (h_minus_aux j) x + \<dots> = (\<Sum>\<^sup>+ x'. h_minus_aux j (x', x) + \<delta> * indicator (set (cycle_edges C)) (x', x))"
     unfolding Suc.IH d_IN_def by(simp add: nn_integral_add[symmetric])
   also have "\<dots> = d_IN (h_minus_aux (Suc j)) x" unfolding d_IN_def
     by(auto intro!: nn_integral_cong simp add: \<delta>_def C_def split: split_indicator)
   finally show ?case .
 qed
 
 lemma h_minus_aux_source:
   assumes "cycles \<Delta> \<noteq> {}"
   shows "h_minus_aux j (source \<Delta>, y) = 0"
 proof(induction j)
   case 0 thus ?case by simp
 next
   case (Suc j)
   have "(source \<Delta>, y) \<notin> set (cycle_edges (enum_cycle j))"
   proof
     assume *: "(source \<Delta>, y) \<in> set (cycle_edges (enum_cycle j))"
     have cycle: "cycle \<Delta> (enum_cycle j)" using assms by(rule cycle_enum_cycle)
     from cycle_leave_ex_enter[OF this *]
     obtain z where "(z, source \<Delta>) \<in> set (cycle_edges (enum_cycle j))" ..
     with cycle_edges_edges[OF cycle] have "(z, source \<Delta>) \<in> \<^bold>E" ..
     thus False using source_in[of z] by simp
   qed
   then show ?case using Suc.IH by simp
 qed
 
 lemma h_minus_aux_cycle:
   fixes j defines "C \<equiv> enum_cycle j"
   assumes "cycles \<Delta> \<noteq> {}"
   shows "\<exists>e\<in>set (cycle_edges C). h_minus_aux (Suc j) e = h' e"
 proof -
   let ?A = "{h' e' - h_minus_aux j e'|e'. e' \<in> set (cycle_edges C)}"
   from assms have "cycle \<Delta> C" by auto
   from cycle_edges_not_Nil[OF this] have "Min ?A \<in> ?A" using [[simproc add: finite_Collect]]
     by(intro Min_in)(fastforce simp add: neq_Nil_conv)+
   then obtain e' where e: "e' \<in> set (cycle_edges C)"
     and "Min ?A = h' e' - h_minus_aux j e'" by auto
   hence "h_minus_aux (Suc j) e' = h' e'"
     by(simp add: C_def h_minus_aux_le_h')
   with e show ?thesis by blast
 qed
 
 end
 
 fun h_minus :: "nat \<Rightarrow> 'v edge \<Rightarrow> ennreal"
 where
   "h_minus 0 e = 0"
 | "h_minus (Suc i) e = h_minus i e + (SUP j. h_minus_aux (\<lambda>e'. h_plus (Suc i) e' - h_minus i e') j e)"
 
 lemma h_minus_le_h_plus: "h_minus i e \<le> h_plus i e"
 proof(induction i e rule: h_minus.induct)
   case 0: (1 e) show ?case by simp
 next
   case Suc: (2 i e)
   note IH = Suc.IH(2)[OF UNIV_I]
   let ?h' = "\<lambda>e'. h_plus (Suc i) e' - h_minus i e'"
-  have h': "?h' e' \<noteq> top" for e' using IH(1)[of e'] bysimp
+  have h': "?h' e' \<noteq> top" for e' using IH(1)[of e'] by simp
 
   have "(\<Squnion>j. h_minus_aux ?h' j e) \<le> ?h' e" by(rule SUP_least)(rule h_minus_aux_le_h'[OF h'])
   hence "h_minus (Suc i) e \<le> h_minus i e + \<dots>" by(simp add: add_mono)
   also have "\<dots> = h_plus (Suc i) e" using IH[of e] h_plus_mono[of i e]
     by auto
   finally show ?case .
 qed
 
 lemma finite_h': "h_plus (Suc i) e - h_minus i e \<noteq> top"
   by simp
 
 lemma h_minus_mono: "h_minus i e \<le> h_minus (Suc i) e"
 proof -
   have "h_minus i e + 0 \<le> h_minus (Suc i) e" unfolding h_minus.simps
     by(rule add_mono; simp add: SUP_upper2)
   thus ?thesis by simp
 qed
 
 lemma h_minus_finite [simp]: "h_minus i e \<noteq> \<top>"
 proof -
   have "h_minus i e \<le> h_plus i e" by(rule h_minus_le_h_plus)
   also have "\<dots> < \<top>" by (simp add: less_top[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma d_OUT_h_minus:
   assumes cycles: "cycles \<Delta> \<noteq> {}"
   shows "d_OUT (h_minus i) x = d_IN (h_minus i) x"
 proof(induction i)
   case (Suc i)
   let ?h' = "\<lambda>e. h_plus (Suc i) e - h_minus i e"
   have "d_OUT (\<lambda>e. h_minus (Suc i) e) x = d_OUT (h_minus i) x + d_OUT (\<lambda>e. SUP j. h_minus_aux ?h' j e) x"
     by(simp add: d_OUT_add SUP_upper2)
   also have "d_OUT (\<lambda>e. SUP j. h_minus_aux ?h' j e) x = (SUP j. d_OUT (h_minus_aux ?h' j) x)"
     by(rule d_OUT_monotone_convergence_SUP incseq_SucI le_funI h_minus_aux_mono finite_h')+
   also have "\<dots> = (SUP j. d_IN (h_minus_aux ?h' j) x)"
     by(rule SUP_cong[OF refl])(rule d_OUT_h_minus_aux[OF finite_h' cycles])
   also have "\<dots> = d_IN (\<lambda>e. SUP j. h_minus_aux ?h' j e) x"
     by(rule d_IN_monotone_convergence_SUP[symmetric] incseq_SucI le_funI h_minus_aux_mono finite_h')+
   also have "d_OUT (h_minus i) x + \<dots> = d_IN (\<lambda>e. h_minus (Suc i) e) x" using Suc.IH
     by(simp add: d_IN_add SUP_upper2)
   finally show ?case .
 qed simp
 
 lemma h_minus_source:
   assumes "cycles \<Delta> \<noteq> {}"
   shows "h_minus n (source \<Delta>, y) = 0"
 by(induction n)(simp_all add: h_minus_aux_source[OF finite_h' assms])
 
 lemma h_minus_source_in [simp]: "h_minus i (x, source \<Delta>) = 0"
 using h_minus_le_h_plus[of i "(x, source \<Delta>)"] by simp
 
 lemma h_minus_OUT_finite [simp]: "d_OUT (h_minus i) x \<noteq> top"
 proof -
   have "d_OUT (h_minus i) x \<le> d_OUT (h_plus i) x" by(rule d_OUT_mono)(rule h_minus_le_h_plus)
   also have "\<dots> < \<top>" by (simp add: less_top[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma h_minus_cycle:
   assumes "cycle \<Delta> C"
   shows "\<exists>e\<in>set (cycle_edges C). h_minus i e = h_plus i e"
 proof(cases i)
   case (Suc i)
   let ?h' = "\<lambda>e. h_plus (Suc i) e - h_minus i e"
   from assms have cycles: "cycles \<Delta> \<noteq> {}" by auto
   with assms from_nat_into_surj[of "cycles \<Delta>" C] obtain j where j: "C = enum_cycle j"
     by(auto simp add: enum_cycle_def)
   from h_minus_aux_cycle[of "?h'" j, OF finite_h' cycles] j
   obtain e where e: "e \<in> set (cycle_edges C)" and "h_minus_aux ?h' (Suc j) e = ?h' e" by(auto)
   then have "h_plus (Suc i) e = h_minus i e + h_minus_aux ?h' (Suc j) e"
     using order_trans[OF h_minus_le_h_plus h_plus_mono]
     by (subst eq_commute) simp
   also have "\<dots> \<le> h_minus (Suc i) e" unfolding h_minus.simps
     by(intro add_mono SUP_upper; simp)
   finally show ?thesis using e h_minus_le_h_plus[of "Suc i" e] Suc by auto
 next
   case 0
   from cycle_edges_not_Nil[OF assms] obtain x y where e: "(x, y) \<in> set (cycle_edges C)"
     by(fastforce simp add: neq_Nil_conv)
   then have "x \<noteq> source \<Delta>" using assms by(auto dest: source_out_not_cycle)
   hence "h_plus 0 (x, y) = 0" by simp
   with e 0 show ?thesis by(auto simp del: h_plus.simps)
 qed
 
 abbreviation lim_h_plus :: "'v edge \<Rightarrow> ennreal"
 where "lim_h_plus e \<equiv> SUP n. h_plus n e"
 
 abbreviation lim_h_minus :: "'v edge \<Rightarrow> ennreal"
 where "lim_h_minus e \<equiv> SUP n. h_minus n e"
 
 lemma lim_h_plus_le_g: "lim_h_plus e \<le> g e"
 by(rule SUP_least)(rule h_plus_le_g)
 
 lemma lim_h_plus_finite [simp]: "lim_h_plus e \<noteq> top"
 proof -
   have "lim_h_plus e \<le> g e" by(rule lim_h_plus_le_g)
   also have "\<dots> < top" by (simp add: less_top[symmetric])
   finally show ?thesis unfolding less_top .
 qed
 
 lemma lim_h_minus_le_lim_h_plus: "lim_h_minus e \<le> lim_h_plus e"
 by(rule SUP_mono)(blast intro: h_minus_le_h_plus)
 
 lemma lim_h_minus_finite [simp]: "lim_h_minus e \<noteq> top"
 proof -
   have "lim_h_minus e \<le> lim_h_plus e" by(rule lim_h_minus_le_lim_h_plus)
   also have "\<dots> < top" unfolding less_top[symmetric] by (rule lim_h_plus_finite)
   finally show ?thesis unfolding less_top[symmetric] by simp
 qed
 
 lemma lim_h_minus_IN_finite [simp]:
   assumes "x \<noteq> sink \<Delta>"
   shows "d_IN lim_h_minus x \<noteq> top"
 proof -
   have "d_IN lim_h_minus x \<le> d_IN lim_h_plus x"
     by(intro d_IN_mono le_funI lim_h_minus_le_lim_h_plus)
   also have "\<dots> \<le> d_IN g x" by(intro d_IN_mono le_funI lim_h_plus_le_g)
   also have "\<dots> < \<top>" using assms by(simp add: finite_IN_g less_top[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma lim_h_plus_OUT_IN:
   assumes "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   shows "d_OUT lim_h_plus x = d_IN lim_h_plus x"
 proof(cases "x \<in> \<^bold>V")
   case True
   have "d_OUT lim_h_plus x = (SUP n. d_OUT (h_plus n) x)"
     by(rule d_OUT_monotone_convergence_SUP incseq_SucI le_funI h_plus_mono)+
   also have "\<dots> = (SUP n. d_IN (h_plus n) x)" (is "?lhs = ?rhs")
   proof(rule antisym)
     show "?lhs \<le> ?rhs" by(rule SUP_mono)(auto intro: h_plus_OUT_le_IN[OF assms(1)])
     show "?rhs \<le> ?lhs"
     proof(rule SUP_mono)
       fix i
       from enum_v_repeat[OF True assms, of i]
       obtain i' where "i' > i" "enum_v i' = x" by auto
       moreover then obtain i'' where i': "i' = Suc i''" by(cases i') auto
       ultimately have "d_OUT (h_plus i') x = d_IN (h_plus i'') x" using  \<open>x \<noteq> source \<Delta>\<close>
         by(simp add: h_plus_OUT_eq_IN)
       moreover have "i \<le> i''" using \<open>i < i'\<close> i' by simp
       then have "d_IN (h_plus i) x \<le> d_IN (h_plus i'') x" by(intro d_IN_mono h_plus_mono')
       ultimately have "d_IN (h_plus i) x \<le> d_OUT (h_plus i') x" by simp
       thus "\<exists>i'\<in>UNIV. d_IN (h_plus i) x \<le> d_OUT (h_plus i') x" by blast
     qed
   qed
   also have "\<dots> = d_IN lim_h_plus x"
     by(rule d_IN_monotone_convergence_SUP[symmetric] incseq_SucI le_funI h_plus_mono)+
   finally show ?thesis .
 next
   case False
   have "(x, y) \<notin> support_flow lim_h_plus" for y using False h_plus_outside[of "(x, y)"]
     by(fastforce elim!: support_flow.cases simp add: less_SUP_iff vertex_def)
   moreover have "(y, x) \<notin> support_flow lim_h_plus" for y using False h_plus_outside[of "(y, x)"]
     by(fastforce elim!: support_flow.cases simp add: less_SUP_iff vertex_def)
   ultimately show ?thesis
     by(auto simp add: d_OUT_alt_def2 d_IN_alt_def2 AE_count_space intro!: nn_integral_cong_AE)
 qed
 
 lemma lim_h_minus_OUT_IN:
   assumes cycles: "cycles \<Delta> \<noteq> {}"
   shows "d_OUT lim_h_minus x = d_IN lim_h_minus x"
 proof -
   have "d_OUT lim_h_minus x = (SUP n. d_OUT (h_minus n) x)"
     by(rule d_OUT_monotone_convergence_SUP incseq_SucI le_funI h_minus_mono)+
   also have "\<dots> = (SUP n. d_IN (h_minus n) x)" using cycles by(simp add: d_OUT_h_minus)
   also have "\<dots> = d_IN lim_h_minus x"
     by(rule d_IN_monotone_convergence_SUP[symmetric] incseq_SucI le_funI h_minus_mono)+
   finally show ?thesis .
 qed
 
 definition h :: "'v edge \<Rightarrow> ennreal"
 where "h e = lim_h_plus e - (if cycles \<Delta> \<noteq> {} then lim_h_minus e else 0)"
 
 lemma h_le_lim_h_plus: "h e \<le> lim_h_plus e"
 by (simp add: h_def)
 
 lemma h_le_g: "h e \<le> g e"
 using h_le_lim_h_plus[of e] lim_h_plus_le_g[of e] by simp
 
 lemma flow_h: "flow \<Delta> h"
 proof
   fix e
   have "h e \<le> lim_h_plus e" by(rule h_le_lim_h_plus)
   also have "\<dots> \<le> g e" by(rule lim_h_plus_le_g)
   also have "\<dots> \<le> capacity \<Delta> e" using g by(rule flowD_capacity)
   finally show "h e \<le> \<dots>" .
 next
   fix x
   assume "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   then show "KIR h x"
     by (cases "cycles \<Delta> = {}")
        (auto simp add: h_def[abs_def] lim_h_plus_OUT_IN d_OUT_diff d_IN_diff lim_h_minus_le_lim_h_plus lim_h_minus_OUT_IN)
 qed
 
 lemma value_h_plus: "value_flow \<Delta> (h_plus i) = value_flow \<Delta> g" (is "?lhs = ?rhs")
 proof(rule antisym)
   show "?lhs \<le> ?rhs" by(rule d_OUT_mono)(rule h_plus_le_g)
 
   have "?rhs \<le> value_flow \<Delta> (h_plus 0)"
     by(auto simp add: d_OUT_def cong: if_cong intro!: nn_integral_mono)
   also have "\<dots> \<le> value_flow \<Delta> (h_plus i)"
     by(rule d_OUT_mono)(rule h_plus_mono'; simp)
   finally show "?rhs \<le> ?lhs" .
 qed
 
 lemma value_h: "value_flow \<Delta> h = value_flow \<Delta> g" (is "?lhs = ?rhs")
 proof(rule antisym)
   have "?lhs \<le> value_flow \<Delta> lim_h_plus" using ennreal_minus_mono
     by(fastforce simp add: h_def intro!: d_OUT_mono)
   also have "\<dots> \<le> ?rhs" by(rule d_OUT_mono)(rule lim_h_plus_le_g)
   finally show "?lhs \<le> ?rhs" .
 
   show "?rhs \<le> ?lhs"
     by(auto simp add: d_OUT_def h_def h_minus_source cong: if_cong intro!: nn_integral_mono SUP_upper2[where i=0])
 qed
 
 
 definition h_diff :: "nat \<Rightarrow> 'v edge \<Rightarrow> ennreal"
 where "h_diff i e = h_plus i e - (if cycles \<Delta> \<noteq> {} then h_minus i e else 0)"
 
 lemma d_IN_h_source [simp]: "d_IN (h_diff i) (source \<Delta>) = 0"
 by(simp add: d_IN_def h_diff_def cong del: if_weak_cong)
 
 lemma h_diff_le_h_plus: "h_diff i e \<le> h_plus i e"
 by(simp add: h_diff_def)
 
 lemma h_diff_le_g: "h_diff i e \<le> g e"
 using h_diff_le_h_plus[of i e] h_plus_le_g[of i e] by simp
 
 lemma h_diff_loop [simp]: "h_diff i (x, x) = 0"
 using h_diff_le_g[of i "(x, x)"] by simp
 
 lemma supp_h_diff_edges: "support_flow (h_diff i) \<subseteq> \<^bold>E"
 proof
   fix e
   assume "e \<in> support_flow (h_diff i)"
   then have "0 < h_diff i e" by(auto elim: support_flow.cases)
   also have "h_diff i e \<le> h_plus i e" by(rule h_diff_le_h_plus)
   finally show "e \<in> \<^bold>E" using h_plus_outside[of e i] by(cases "e \<in> \<^bold>E") auto
 qed
 
 lemma h_diff_OUT_le_IN:
   assumes "x \<noteq> source \<Delta>"
   shows "d_OUT (h_diff i) x \<le> d_IN (h_diff i) x"
 proof(cases "cycles \<Delta> \<noteq> {}")
   case False
   thus ?thesis using assms by(simp add: h_diff_def[abs_def] h_plus_OUT_le_IN)
 next
   case cycles: True
   then have "d_OUT (h_diff i) x = d_OUT (h_plus i) x - d_OUT (h_minus i) x"
     unfolding h_diff_def[abs_def] using assms
     by (simp add: h_minus_le_h_plus d_OUT_diff)
   also have "\<dots> \<le> d_IN (h_plus i) x - d_IN (h_minus i) x" using cycles assms
     by(intro ennreal_minus_mono h_plus_OUT_le_IN)(simp_all add: d_OUT_h_minus)
   also have "\<dots> = d_IN (h_diff i) x" using cycles
     unfolding h_diff_def[abs_def] by(subst d_IN_diff)(simp_all add: h_minus_le_h_plus d_OUT_h_minus[symmetric])
   finally show ?thesis .
 qed
 
 lemma h_diff_cycle:
   assumes "cycle \<Delta> p"
   shows "\<exists>e\<in>set (cycle_edges p). h_diff i e = 0"
 proof -
   from h_minus_cycle[OF assms, of i] obtain e
     where e: "e \<in> set (cycle_edges p)" and "h_minus i e = h_plus i e" by auto
   hence "h_diff i e = 0" using assms by(auto simp add: h_diff_def)
   with e show ?thesis by blast
 qed
 
 lemma d_IN_h_le_value': "d_IN (h_diff i) x \<le> value_flow \<Delta> (h_plus i)"
 proof -
   let ?supp = "support_flow (h_diff i)"
   define X where "X = {y. (y, x) \<in> ?supp^*} - {x}"
 
   { fix x y
     assume x: "x \<notin> X" and y: "y \<in> X"
     { assume yx: "(y, x) \<in> ?supp\<^sup>*" and neq: "y \<noteq> x" and xy: "(x, y) \<in> ?supp"
       from yx obtain p' where "rtrancl_path (\<lambda>x y. (x, y) \<in> ?supp) y p' x"
         unfolding rtrancl_def rtranclp_eq_rtrancl_path by auto
       then obtain p where p: "rtrancl_path (\<lambda>x y. (x, y) \<in> ?supp) y p x"
         and distinct: "distinct (y # p)" by(rule rtrancl_path_distinct)
       with neq have "p \<noteq> []" by(auto elim: rtrancl_path.cases)
 
       from xy have "(x, y) \<in> \<^bold>E" using supp_h_diff_edges[of i] by(auto)
       moreover from p have "path \<Delta> y p x"
         by(rule rtrancl_path_mono)(auto dest: supp_h_diff_edges[THEN subsetD])
       ultimately have "path \<Delta> x (y # p) x" by(auto intro: rtrancl_path.intros)
       hence cycle: "cycle \<Delta> (y # p)" using _ distinct by(rule cycle) simp
       from h_diff_cycle[OF this, of i] obtain e
         where e: "e \<in> set (cycle_edges (y # p))" and 0: "h_diff i e = 0" by blast
       from e obtain n where e': "e = ((y # p) ! n, (p @ [y]) ! n)" and n: "n < Suc (length p)"
         by(auto simp add: cycle_edges_def set_zip)
       have "e \<in> ?supp"
       proof(cases "n = length p")
         case True
         with rtrancl_path_last[OF p] \<open>p \<noteq> []\<close> have "(y # p) ! n = x"
           by(cases p)(simp_all add: last_conv_nth del: last.simps)
         with e' True have "e = (x, y)" by simp
         with xy show ?thesis by simp
       next
         case False
         with n have "n < length p" by simp
         with rtrancl_path_nth[OF p this] e' show ?thesis by(simp add: nth_append)
       qed
       with 0 have False by(simp add: support_flow.simps) }
     hence "(x, y) \<notin> ?supp" using x y
       by(auto simp add: X_def intro: converse_rtrancl_into_rtrancl)
     then have "h_diff i (x, y) = 0"
       by(simp add: support_flow.simps) }
   note acyclic = this
 
   { fix y
     assume "y \<notin> X"
     hence "(y, x) \<notin> ?supp" by(auto simp add: X_def support_flow.simps intro: not_in_support_flowD)
     hence "h_diff i (y, x) = 0"  by(simp add: support_flow.simps) }
   note in_X = this
 
   let ?diff = "\<lambda>x. (\<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x * indicator X y)"
   have finite2: "(\<Sum>\<^sup>+ x. ?diff x) \<noteq> top" (is "?lhs \<noteq> _")
   proof -
     have "?lhs \<le> (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_plus i (x, y))"
       by(intro nn_integral_mono)(auto simp add: h_diff_def split: split_indicator)
     also have "\<dots> = (\<Sum>\<^sup>+ e. h_plus i e)" by(rule nn_integral_fst_count_space)
     also have "\<dots> < \<top>" by(simp add: h_plus_sum_finite less_top[symmetric])
     finally show ?thesis by simp
   qed
   have finite1: "?diff x \<noteq> top" for x
     using finite2 by(rule neq_top_trans)(rule nn_integral_ge_point, simp)
   have finite3: "(\<Sum>\<^sup>+ x. d_OUT (h_diff i) x * indicator (X - {source \<Delta>}) x) \<noteq> \<top>" (is "?lhs \<noteq> _")
   proof -
     have "?lhs \<le> (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_plus i (x, y))" unfolding d_OUT_def
       apply(simp add: nn_integral_multc[symmetric])
       apply(intro nn_integral_mono)
       apply(auto simp add: h_diff_def split: split_indicator)
       done
     also have "\<dots> = (\<Sum>\<^sup>+ e. h_plus i e)" by(rule nn_integral_fst_count_space)
     also have "\<dots> < \<top>" by(simp add: h_plus_sum_finite less_top[symmetric])
     finally show ?thesis by simp
   qed
 
   have "d_IN (h_diff i) x = (\<Sum>\<^sup>+ y. h_diff i (y, x) * indicator X y)" unfolding d_IN_def
     by(rule nn_integral_cong)(simp add: in_X split: split_indicator)
   also have "\<dots> \<le> (\<Sum>\<^sup>+ x\<in>- X. \<Sum>\<^sup>+ y. h_diff i (y, x) * indicator X y)"
     by(rule nn_integral_ge_point)(simp add: X_def)
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_diff i (y, x) * indicator X y * indicator (- X) x)"
     by(simp add: nn_integral_multc nn_integral_count_space_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x * indicator (- X) y)"
     by(subst nn_integral_snd_count_space[where f="case_prod _", simplified])(simp add: nn_integral_fst_count_space[where f="case_prod _", simplified])
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. (\<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x * indicator (- X) y) + (?diff x - ?diff x))"
     by(simp add: finite1)
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. (\<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x * indicator (- X) y + h_diff i (x, y) * indicator X x * indicator X y) - ?diff x)"
     apply (subst add_diff_eq_ennreal)
     apply simp
     by(subst nn_integral_add[symmetric])(simp_all add:)
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. (\<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x) - ?diff x)"
     by(auto intro!: nn_integral_cong arg_cong2[where f="(-)"] split: split_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y\<in>UNIV. h_diff i (x, y) * indicator X x) - (\<Sum>\<^sup>+ x. ?diff x)"
     by(subst nn_integral_diff)(auto simp add: AE_count_space finite2 intro!: nn_integral_mono split: split_indicator)
   also have "(\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y\<in>UNIV. h_diff i (x, y) * indicator X x) = (\<Sum>\<^sup>+ x. d_OUT (h_diff i) x * indicator X x)"
     unfolding d_OUT_def by(simp add: nn_integral_multc)
   also have "\<dots> = (\<Sum>\<^sup>+ x. d_OUT (h_diff i) x * indicator (X - {source \<Delta>}) x + value_flow \<Delta> (h_diff i) * indicator X (source \<Delta>) * indicator {source \<Delta>} x)"
     by(rule nn_integral_cong)(simp split: split_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ x. d_OUT (h_diff i) x * indicator (X - {source \<Delta>}) x) + value_flow \<Delta> (h_diff i) * indicator X (source \<Delta>)"
     (is "_ = ?out" is "_ = _ + ?value")
     by(subst nn_integral_add) simp_all
   also have "(\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X x * indicator X y) =
              (\<Sum>\<^sup>+ x\<in>UNIV. \<Sum>\<^sup>+ y. h_diff i (x, y) * indicator X y)"
     using acyclic by(intro nn_integral_cong)(simp split: split_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>UNIV. \<Sum>\<^sup>+ x. h_diff i (x, y) * indicator X y)"
     by(subst nn_integral_snd_count_space[where f="case_prod _", simplified])(simp add: nn_integral_fst_count_space[where f="case_prod _", simplified])
   also have "\<dots> = (\<Sum>\<^sup>+ y. d_IN (h_diff i) y * indicator X y)" unfolding d_IN_def
     by(simp add: nn_integral_multc)
   also have "\<dots> = (\<Sum>\<^sup>+ y. d_IN (h_diff i) y * indicator (X - {source \<Delta>}) y)"
     by(rule nn_integral_cong)(simp split: split_indicator)
   also have "?out - \<dots> \<le> (\<Sum>\<^sup>+ x. d_OUT (h_diff i) x * indicator (X - {source \<Delta>}) x) - \<dots> + ?value"
     by (auto simp add: add_ac intro!: add_diff_le_ennreal)
   also have "\<dots> \<le> 0 + ?value" using h_diff_OUT_le_IN finite3
     by(intro nn_integral_mono add_right_mono)(auto split: split_indicator intro!: diff_eq_0_ennreal nn_integral_mono simp add: less_top)
   also have "\<dots> \<le> value_flow \<Delta> (h_diff i)" by(simp split: split_indicator)
   also have "\<dots> \<le> value_flow \<Delta> (h_plus i)" by(rule d_OUT_mono le_funI h_diff_le_h_plus)+
   finally show ?thesis .
 qed
 
 lemma d_IN_h_le_value: "d_IN h x \<le> value_flow \<Delta> h" (is "?lhs \<le> ?rhs")
 proof -
   have [tendsto_intros]: "(\<lambda>i. h_plus i e) \<longlonglongrightarrow> lim_h_plus e" for e
     by(rule LIMSEQ_SUP incseq_SucI h_plus_mono)+
   have [tendsto_intros]: "(\<lambda>i. h_minus i e) \<longlonglongrightarrow> lim_h_minus e" for e
     by(rule LIMSEQ_SUP incseq_SucI h_minus_mono)+
   have "(\<lambda>i. h_diff i e) \<longlonglongrightarrow> lim_h_plus e - (if cycles \<Delta> \<noteq> {} then lim_h_minus e else 0)" for e
     by(auto intro!: tendsto_intros tendsto_diff_ennreal simp add: h_diff_def simp del: Sup_eq_top_iff SUP_eq_top_iff)
   then have "d_IN h x = (\<Sum>\<^sup>+ y. liminf (\<lambda>i. h_diff i (y, x)))"
     by(simp add: d_IN_def h_def tendsto_iff_Liminf_eq_Limsup)
   also have "\<dots> \<le> liminf (\<lambda>i. d_IN (h_diff i) x)" unfolding d_IN_def
     by(rule nn_integral_liminf) simp_all
   also have "\<dots> \<le> liminf (\<lambda>i. value_flow \<Delta> h)" using d_IN_h_le_value'[of _ x]
     by(intro Liminf_mono eventually_sequentiallyI)(auto simp add: value_h_plus value_h)
   also have "\<dots> = value_flow \<Delta> h" by(simp add: Liminf_const)
   finally show ?thesis .
 qed
 
 lemma flow_cleanup: \<comment> \<open>Lemma 5.4\<close>
   "\<exists>h \<le> g. flow \<Delta> h \<and> value_flow \<Delta> h = value_flow \<Delta> g \<and> (\<forall>x. d_IN h x \<le> value_flow \<Delta> h)"
 by(intro exI[where x=h] conjI strip le_funI d_IN_h_le_value flow_h value_h h_le_g)
 
 end
 
 subsection \<open>Residual network\<close>
 
 context countable_network begin
 
 definition residual_network :: "'v flow \<Rightarrow> ('v, 'more) network_scheme"
 where "residual_network f =
   \<lparr>edge = \<lambda>x y. edge \<Delta> x y \<or> edge \<Delta> y x \<and> y \<noteq> source \<Delta>,
    capacity = \<lambda>(x, y). if edge \<Delta> x y then capacity \<Delta> (x, y) - f (x, y) else if y = source \<Delta> then 0 else f (y, x),
    source = source \<Delta>, sink = sink \<Delta>, \<dots> = network.more \<Delta> \<rparr>"
 
 lemma residual_network_sel [simp]:
   "edge (residual_network f) x y \<longleftrightarrow> edge \<Delta> x y \<or> edge \<Delta> y x \<and> y \<noteq> source \<Delta>"
   "capacity (residual_network f) (x, y) = (if edge \<Delta> x y then capacity \<Delta> (x, y) - f (x, y) else if y = source \<Delta> then 0 else f (y, x))"
   "source (residual_network f) = source \<Delta>"
   "sink (residual_network f) = sink \<Delta>"
   "network.more (residual_network f) = network.more \<Delta>"
 by(simp_all add: residual_network_def)
 
 lemma "\<^bold>E_residual_network": "\<^bold>E\<^bsub>residual_network f\<^esub> = \<^bold>E \<union> {(x, y). (y, x) \<in> \<^bold>E \<and> y \<noteq> source \<Delta>}"
 by auto
 
 lemma vertices_residual_network [simp]: "vertex (residual_network f) = vertex \<Delta>"
 by(auto simp add: vertex_def fun_eq_iff)
 
 inductive wf_residual_network :: "bool"
 where "\<lbrakk> \<And>x y. (x, y) \<in> \<^bold>E \<Longrightarrow> (y, x) \<notin> \<^bold>E; (source \<Delta>, sink \<Delta>) \<notin> \<^bold>E \<rbrakk> \<Longrightarrow> wf_residual_network"
 
 lemma wf_residual_networkD:
   "\<lbrakk> wf_residual_network; edge \<Delta> x y \<rbrakk> \<Longrightarrow> \<not> edge \<Delta> y x"
   "\<lbrakk> wf_residual_network; e \<in> \<^bold>E \<rbrakk> \<Longrightarrow> prod.swap e \<notin> \<^bold>E"
   "\<lbrakk> wf_residual_network; edge \<Delta> (source \<Delta>) (sink \<Delta>) \<rbrakk> \<Longrightarrow> False"
 by(auto simp add: wf_residual_network.simps)
 
 lemma residual_countable_network:
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   shows "countable_network (residual_network f)" (is "countable_network ?\<Delta>")
 proof
   have "countable (converse \<^bold>E)" by simp
   then have "countable {(x, y). (y, x) \<in> \<^bold>E \<and> y \<noteq> source \<Delta>}"
     by(rule countable_subset[rotated]) auto
   then show "countable \<^bold>E\<^bsub>?\<Delta>\<^esub>" unfolding "\<^bold>E_residual_network" by simp
 
   show "source ?\<Delta> \<noteq> sink ?\<Delta>" by simp
   show "capacity ?\<Delta> e = 0" if "e \<notin> \<^bold>E\<^bsub>?\<Delta>\<^esub>" for e using that by(cases e)(auto intro: flowD_outside[OF f])
   show "capacity ?\<Delta> e \<noteq> top" for e
     using flowD_finite[OF f] by(cases e) auto
 qed
 
 end
 
 context antiparallel_edges begin
 
 interpretation \<Delta>'': countable_network \<Delta>'' by(rule \<Delta>''_countable_network)
 
 lemma \<Delta>''_flow_attainability:
   assumes "flow_attainability_axioms \<Delta>"
   shows "flow_attainability \<Delta>''"
 proof -
   interpret flow_attainability \<Delta> using _ assms by(rule flow_attainability.intro) unfold_locales
   show ?thesis
   proof
     show "d_IN (capacity \<Delta>'') v \<noteq> \<top> \<or> d_OUT (capacity \<Delta>'') v \<noteq> \<top>" if "v \<noteq> sink \<Delta>''" for v
       using that finite_capacity by(cases v)(simp_all add: max_def)
     show "\<not> edge \<Delta>'' v v" for v by(auto elim: edg.cases)
     show "\<not> edge \<Delta>'' v (source \<Delta>'')" for v by(simp add: source_in)
   qed
 qed
 
 lemma \<Delta>''_wf_residual_network:
   assumes no_loop: "\<And>x. \<not> edge \<Delta> x x"
   shows "\<Delta>''.wf_residual_network"
 by(auto simp add: \<Delta>''.wf_residual_network.simps assms elim!: edg.cases)
 
 end
 
 subsection \<open>The attainability theorem\<close>
 
 context flow_attainability begin
 
 lemma residual_flow_attainability:
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   shows "flow_attainability (residual_network f)" (is "flow_attainability ?\<Delta>")
 proof -
   interpret res: countable_network "residual_network f" by(rule residual_countable_network[OF assms])
   show ?thesis
   proof
     fix x
     assume sink: "x \<noteq> sink ?\<Delta>"
     then consider (source) "x = source \<Delta>" | (IN) "d_IN (capacity \<Delta>) x \<noteq> \<top>" | (OUT) "x \<noteq> source \<Delta>" "d_OUT (capacity \<Delta>) x \<noteq> \<top>"
       using finite_capacity[of x] by auto
     then show "d_IN (capacity ?\<Delta>) x \<noteq> \<top> \<or> d_OUT (capacity ?\<Delta>) x \<noteq> \<top>"
     proof(cases)
       case source
       hence "d_IN (capacity ?\<Delta>) x = 0" by(simp add: d_IN_def source_in)
       thus ?thesis by simp
     next
       case IN
       have "d_IN (capacity ?\<Delta>) x =
         (\<Sum>\<^sup>+ y. (capacity \<Delta> (y, x) - f (y, x)) * indicator \<^bold>E (y, x) +
               (if x = source \<Delta> then 0 else f (x, y) * indicator \<^bold>E (x, y)))"
         using flowD_outside[OF f] unfolding d_IN_def
         by(auto intro!: nn_integral_cong split: split_indicator dest: wf_residual_networkD[OF wf])
       also have "\<dots> = (\<Sum>\<^sup>+ y. (capacity \<Delta> (y, x) - f (y, x)) * indicator \<^bold>E (y, x)) +
         (\<Sum>\<^sup>+ y. (if x = source \<Delta> then 0 else f (x, y) * indicator \<^bold>E (x, y)))"
         (is "_ = ?in + ?out")
         by(subst nn_integral_add)(auto simp add: AE_count_space split: split_indicator intro!: flowD_capacity[OF f])
       also have "\<dots> \<le> d_IN (capacity \<Delta>) x + (if x = source \<Delta> then 0 else d_OUT f x)" (is "_ \<le> ?in + ?rest")
         unfolding d_IN_def d_OUT_def
         by(rule add_mono)(auto intro!: nn_integral_mono split: split_indicator simp add: nn_integral_0_iff_AE AE_count_space intro!: diff_le_self_ennreal)
       also consider (source) "x = source \<Delta>" | (inner) "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>" using sink by auto
       then have "?rest < \<top>"
       proof cases
         case inner
         show ?thesis using inner flowD_finite_OUT[OF f inner] by (simp add: less_top)
       qed simp
       ultimately show ?thesis using IN sink by (auto simp: less_top[symmetric] top_unique)
     next
       case OUT
       have "d_OUT (capacity ?\<Delta>) x =
         (\<Sum>\<^sup>+ y. (capacity \<Delta> (x, y) - f (x, y)) * indicator \<^bold>E (x, y) +
               (if y = source \<Delta> then 0 else f (y, x) * indicator \<^bold>E (y, x)))"
         using flowD_outside[OF f] unfolding d_OUT_def
         by(auto intro!: nn_integral_cong split: split_indicator dest: wf_residual_networkD[OF wf] simp add: source_in)
       also have "\<dots> = (\<Sum>\<^sup>+ y. (capacity \<Delta> (x, y) - f (x, y)) * indicator \<^bold>E (x, y)) +
         (\<Sum>\<^sup>+ y. (if y = source \<Delta> then 0 else f (y, x) * indicator \<^bold>E (y, x)))"
         (is "_ = ?in + ?out")
         by(subst nn_integral_add)(auto simp add: AE_count_space split: split_indicator intro!: flowD_capacity[OF f])
       also have "\<dots> \<le> d_OUT (capacity \<Delta>) x + d_IN f x" (is "_ \<le> ?out + ?rest")
         unfolding d_IN_def d_OUT_def
         by(rule add_mono)(auto intro!: nn_integral_mono split: split_indicator simp add: nn_integral_0_iff_AE AE_count_space intro!: diff_le_self_ennreal)
       also have "?rest = d_OUT f x" using flowD_KIR[OF f OUT(1)] sink by simp
       also have "?out + \<dots> \<le> ?out + ?out" by(intro add_left_mono d_OUT_mono flowD_capacity[OF f])
       finally show ?thesis using OUT by (auto simp: top_unique)
     qed
   next
     show "\<not> edge ?\<Delta> x x" for x by(simp add: no_loop)
     show "\<not> edge ?\<Delta> x (source ?\<Delta>)" for x by(simp add: source_in)
   qed
 qed
 
 end
 
 definition plus_flow :: "('v, 'more) graph_scheme \<Rightarrow> 'v flow \<Rightarrow> 'v flow \<Rightarrow> 'v flow" (infixr "\<oplus>\<index>" 65)
 where "plus_flow G f g = (\<lambda>(x, y). if edge G x y then f (x, y) + g (x, y) - g (y, x) else 0)"
 
 lemma plus_flow_simps [simp]: fixes G (structure) shows
   "(f \<oplus> g) (x, y) = (if edge G x y then f (x, y) + g (x, y) - g (y, x) else 0)"
 by(simp add: plus_flow_def)
 
 lemma plus_flow_outside: fixes G (structure) shows "e \<notin> \<^bold>E \<Longrightarrow> (f \<oplus> g) e = 0"
 by(cases e) simp
 
 lemma
   fixes \<Delta> (structure)
   assumes f_outside: "\<And>e. e \<notin> \<^bold>E \<Longrightarrow> f e = 0"
   and g_le_f: "\<And>x y. edge \<Delta> x y \<Longrightarrow> g (y, x) \<le> f (x, y)"
   shows OUT_plus_flow: "d_IN g x \<noteq> top \<Longrightarrow> d_OUT (f \<oplus> g) x = d_OUT f x + (\<Sum>\<^sup>+ y\<in>UNIV. g (x, y) * indicator \<^bold>E (x, y)) - (\<Sum>\<^sup>+ y. g (y, x) * indicator \<^bold>E (x, y))"
     (is "_ \<Longrightarrow> ?OUT" is "_ \<Longrightarrow> _ = _ + ?g_out - ?g_out'")
   and IN_plus_flow: "d_OUT g x \<noteq> top \<Longrightarrow> d_IN (f \<oplus> g) x = d_IN f x + (\<Sum>\<^sup>+ y\<in>UNIV. g (y, x) * indicator \<^bold>E (y, x)) - (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (y, x))"
     (is "_ \<Longrightarrow> ?IN" is "_ \<Longrightarrow> _ = _ + ?g_in - ?g_in'")
 proof -
   assume "d_IN g x \<noteq> top"
   then have finite1: "(\<Sum>\<^sup>+ y. g (y, x) * indicator A (f y)) \<noteq> top" for A f
     by(rule neq_top_trans)(auto split: split_indicator simp add: d_IN_def intro!: nn_integral_mono)
 
   have "d_OUT (f \<oplus> g) x = (\<Sum>\<^sup>+ y. (g (x, y) + (f (x, y) - g (y, x))) * indicator \<^bold>E (x, y))"
     unfolding d_OUT_def by(rule nn_integral_cong)(simp split: split_indicator add: add_diff_eq_ennreal add.commute ennreal_diff_add_assoc g_le_f)
   also have "\<dots> = ?g_out + (\<Sum>\<^sup>+ y. (f (x, y) - g (y, x)) * indicator \<^bold>E (x, y))"
     (is "_ = _ + ?rest")
     by(subst nn_integral_add[symmetric])(auto simp add: AE_count_space g_le_f split: split_indicator intro!: nn_integral_cong)
   also have "?rest = (\<Sum>\<^sup>+ y. f (x, y) * indicator \<^bold>E (x, y)) - ?g_out'" (is "_ = ?f - _")
     apply(subst nn_integral_diff[symmetric])
     apply(auto intro!: nn_integral_cong split: split_indicator simp add: AE_count_space g_le_f finite1)
     done
   also have "?f = d_OUT f x" unfolding d_OUT_def using f_outside
     by(auto intro!: nn_integral_cong split: split_indicator)
   also have "(\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (x, y)) + (d_OUT f x - (\<Sum>\<^sup>+ y. g (y, x) * indicator \<^bold>E (x, y))) =
      d_OUT f x + ?g_out - ?g_out'"
      by (subst ennreal_diff_add_assoc[symmetric])
         (auto simp: ac_simps d_OUT_def intro!: nn_integral_mono g_le_f split: split_indicator)
   finally show ?OUT .
 next
   assume "d_OUT g x \<noteq> top"
   then have finite2: "(\<Sum>\<^sup>+ y. g (x, y) * indicator A (f y)) \<noteq> top" for A f
     by(rule neq_top_trans)(auto split: split_indicator simp add: d_OUT_def intro!: nn_integral_mono)
 
   have "d_IN (f \<oplus> g) x = (\<Sum>\<^sup>+ y. (g (y, x) + (f (y, x) - g (x, y))) * indicator \<^bold>E (y, x))"
     unfolding d_IN_def by(rule nn_integral_cong)(simp split: split_indicator add: add_diff_eq_ennreal add.commute ennreal_diff_add_assoc g_le_f)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>UNIV. g (y, x) * indicator \<^bold>E (y, x)) + (\<Sum>\<^sup>+ y. (f (y, x) - g (x, y)) * indicator \<^bold>E (y, x))"
     (is "_ = _ + ?rest")
     by(subst nn_integral_add[symmetric])(auto simp add: AE_count_space g_le_f split: split_indicator intro!: nn_integral_cong)
   also have "?rest = (\<Sum>\<^sup>+ y. f (y, x) * indicator \<^bold>E (y, x))- ?g_in'"
     by(subst nn_integral_diff[symmetric])(auto intro!: nn_integral_cong split: split_indicator simp add: add_ac add_diff_eq_ennreal AE_count_space g_le_f finite2)
   also have "(\<Sum>\<^sup>+ y. f (y, x) * indicator \<^bold>E (y, x)) = d_IN f x"
     unfolding d_IN_def using f_outside by(auto intro!: nn_integral_cong split: split_indicator)
   also have "(\<Sum>\<^sup>+ y. g (y, x) * indicator \<^bold>E (y, x)) + (d_IN f x - (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (y, x))) =
      d_IN f x + ?g_in - ?g_in'"
      by (subst ennreal_diff_add_assoc[symmetric])
         (auto simp: ac_simps d_IN_def intro!: nn_integral_mono g_le_f split: split_indicator)
   finally show ?IN .
 qed
 
 context countable_network begin
 
 lemma d_IN_plus_flow:
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   and g: "flow (residual_network f) g"
   shows "d_IN (f \<oplus> g) x \<le> d_IN f x + d_IN g x"
 proof -
   have "d_IN (f \<oplus> g) x \<le> (\<Sum>\<^sup>+ y. f (y, x) + g (y, x))" unfolding d_IN_def
     by(rule nn_integral_mono)(auto intro: diff_le_self_ennreal)
   also have "\<dots> = d_IN f x + d_IN g x"
     by(subst nn_integral_add)(simp_all add: d_IN_def)
   finally show ?thesis .
 qed
 
 lemma scale_flow:
   assumes f: "flow \<Delta> f"
   and c: "c \<le> 1"
   shows "flow \<Delta> (\<lambda>e. c * f e)"
 proof(intro flow.intros)
   fix e
   from c have "c * f e \<le> 1 * f e" by(rule mult_right_mono) simp
   also have "\<dots> \<le> capacity \<Delta> e" using flowD_capacity[OF f, of e] by simp
   finally show "c * f e \<le> \<dots>" .
 next
   fix x
   assume x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   have "d_OUT (\<lambda>e. c * f e) x = c * d_OUT f x" by(simp add: d_OUT_cmult)
   also have "d_OUT f x = d_IN f x" using f x by(rule flowD_KIR)
   also have "c * \<dots> = d_IN (\<lambda>e. c * f e) x" by(simp add: d_IN_cmult)
   finally show "KIR (\<lambda>e. c * f e) x" .
 qed
 
 lemma value_scale_flow:
   "value_flow \<Delta> (\<lambda>e. c * f e) = c * value_flow \<Delta> f"
 by(rule d_OUT_cmult)
 
 lemma value_flow:
   assumes f: "flow \<Delta> f"
   and source_out: "\<And>y. edge \<Delta> (source \<Delta>) y \<longleftrightarrow> y = x"
   shows "value_flow \<Delta> f = f (source \<Delta>, x)"
 proof -
   have "value_flow \<Delta> f = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T (source \<Delta>). f (source \<Delta>, y))"
     by(rule d_OUT_alt_def)(simp add: flowD_outside[OF f])
   also have "\<dots> = (\<Sum>\<^sup>+ y. f (source \<Delta>, y) * indicator {x} y)"
     by(subst nn_integral_count_space_indicator)(auto intro!: nn_integral_cong split: split_indicator simp add: outgoing_def source_out)
   also have "\<dots> = f (source \<Delta>, x)" by(simp add: one_ennreal_def[symmetric] max_def)
   finally show ?thesis .
 qed
 
 end
 
 context flow_attainability begin
 
 lemma value_plus_flow:
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   and g: "flow (residual_network f) g"
   shows "value_flow \<Delta> (f \<oplus> g) = value_flow \<Delta> f + value_flow \<Delta> g"
 proof -
   interpret RES: countable_network "residual_network f" using wf f by(rule residual_countable_network)
   have "value_flow \<Delta> (f \<oplus> g) = (\<Sum>\<^sup>+ y. f (source \<Delta>, y) + g (source \<Delta>, y))"
     unfolding d_OUT_def by(rule nn_integral_cong)(simp add: flowD_outside[OF f] RES.flowD_outside[OF g] source_in)
   also have "\<dots> = value_flow \<Delta> f + value_flow \<Delta> g" unfolding d_OUT_def
     by(rule nn_integral_add) simp_all
   finally show ?thesis .
 qed
 
 lemma flow_residual_add: \<comment> \<open>Lemma 5.3\<close>
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   and g: "flow (residual_network f) g"
   shows "flow \<Delta> (f \<oplus> g)"
 proof
   fix e
   { assume e: "e \<in> \<^bold>E"
     hence "(f \<oplus> g) e = f e + g e - g (prod.swap e)" by(cases e) simp
     also have "\<dots> \<le> f e + g e - 0" by(rule ennreal_minus_mono) simp_all
     also have "\<dots> \<le> f e + (capacity \<Delta> e - f e)"
       using e flowD_capacity[OF g, of e] by(simp split: prod.split_asm add: add_mono)
     also have "\<dots> = capacity \<Delta> e" using flowD_capacity[OF f, of e]
       by simp
     also note calculation }
   thus "(f \<oplus> g) e \<le> capacity \<Delta> e" by(cases e) auto
 next
   fix x
   assume x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   have g_le_f: "g (y, x) \<le> f (x, y)" if "edge \<Delta> x y" for x y
     using that flowD_capacity[OF g, of "(y, x)"]
     by(auto split: if_split_asm dest: wf_residual_networkD[OF wf] elim: order_trans)
 
   interpret RES: flow_attainability "residual_network f" using wf f by(rule residual_flow_attainability)
 
   have finite1: "(\<Sum>\<^sup>+ y. g (y, x) * indicator A (f y)) \<noteq> \<top>" for A f
     using RES.flowD_finite_IN[OF g, of x]
     by(rule neq_top_trans)(auto simp add: x d_IN_def split: split_indicator intro: nn_integral_mono)
   have finite2: "(\<Sum>\<^sup>+ y. g (x, y) * indicator A (f y)) \<noteq> \<top>" for A f
     using RES.flowD_finite_OUT[OF g, of x]
     by(rule neq_top_trans)(auto simp add: x d_OUT_def split: split_indicator intro: nn_integral_mono)
 
   have "d_OUT (f \<oplus> g) x = d_OUT f x + (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (x, y)) - (\<Sum>\<^sup>+ y. g (y, x) * indicator \<^bold>E (x, y))"
     (is "_ = ?f + ?g_out - ?g_in")
     using flowD_outside[OF f] g_le_f RES.flowD_finite_IN[OF g, of x]
     by(rule OUT_plus_flow)(simp_all add: x)
   also have "?f = d_IN f x" using f x by(auto dest: flowD_KIR)
   also have "?g_out = (\<Sum>\<^sup>+ y. g (x, y) * indicator (- \<^bold>E) (y, x))"
   proof -
     have "(\<Sum>\<^sup>+ y. g (x, y) * indicator (- \<^bold>E) (y, x)) =
           (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (x, y)) + (\<Sum>\<^sup>+ y. g (x, y) * indicator (- \<^bold>E) (x, y) * indicator (- \<^bold>E) (y, x))"
       by(subst nn_integral_add[symmetric])(auto simp add: AE_count_space dest: wf_residual_networkD[OF wf] split: split_indicator intro!: nn_integral_cong)
     also have "(\<Sum>\<^sup>+ y. g (x, y) * indicator (- \<^bold>E) (x, y) * indicator (- \<^bold>E) (y, x)) = 0"
       using RES.flowD_outside[OF g]
       by(auto simp add: nn_integral_0_iff_AE AE_count_space split: split_indicator)
     finally show ?thesis by simp
   qed
   also have "\<dots> = (\<Sum>\<^sup>+ y. g (x, y) - g (x, y) * indicator \<^bold>E (y, x))"
     by(rule nn_integral_cong)(simp split: split_indicator add: RES.flowD_finite[OF g])
   also have "\<dots> = d_OUT g x - (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (y, x))"
     (is "_ = _ - ?g_in_E") unfolding d_OUT_def
     by(subst nn_integral_diff)(simp_all add: AE_count_space finite2 split: split_indicator)
   also have "d_IN f x + (d_OUT g x - (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (y, x))) - ?g_in =
     ((d_IN f x + d_OUT g x) - (\<Sum>\<^sup>+ y. g (x, y) * indicator \<^bold>E (y, x))) - ?g_in"
     by (subst add_diff_eq_ennreal) (auto simp: d_OUT_def intro!: nn_integral_mono split: split_indicator)
   also have "d_OUT g x = d_IN g x" using x g by(auto dest: flowD_KIR)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>UNIV. g (y, x) * indicator (- \<^bold>E) (y, x)) + (\<Sum>\<^sup>+ y. g (y, x) * indicator \<^bold>E (y, x))"
     (is "_ = ?x + ?g_in_E'")
     by(subst nn_integral_add[symmetric])(auto intro!: nn_integral_cong simp add: d_IN_def AE_count_space split: split_indicator)
   also have "?x = ?g_in"
   proof -
     have "?x = (\<Sum>\<^sup>+ y. g (y, x) * indicator (- \<^bold>E) (x, y) * indicator (- \<^bold>E) (y, x)) + ?g_in"
       by(subst nn_integral_add[symmetric])(auto simp add: AE_count_space  dest: wf_residual_networkD[OF wf] split: split_indicator intro!: nn_integral_cong)
     also have "(\<Sum>\<^sup>+ y. g (y, x) * indicator (- \<^bold>E) (x, y) * indicator (- \<^bold>E) (y, x)) = 0"
       using RES.flowD_outside[OF g]
       by(auto simp add: nn_integral_0_iff_AE AE_count_space split: split_indicator)
     finally show ?thesis by simp
   qed
   also have "(d_IN f x + (?g_in + ?g_in_E') - ?g_in_E) - ?g_in =
     d_IN f x + ?g_in_E' + ?g_in - ?g_in - ?g_in_E"
     by (subst diff_diff_commute_ennreal) (simp add: ac_simps)
   also have "\<dots> = d_IN f x + ?g_in_E' - ?g_in_E"
     by (subst ennreal_add_diff_cancel_right) (simp_all add: finite1)
   also have "\<dots> = d_IN (f \<oplus> g) x"
     using flowD_outside[OF f]  g_le_f RES.flowD_finite_OUT[OF g, of x]
     by(rule IN_plus_flow[symmetric])(simp_all add: x)
   finally show "KIR (f \<oplus> g) x" by simp
 qed
 
 definition minus_flow :: "'v flow \<Rightarrow> 'v flow \<Rightarrow> 'v flow" (infixl "\<ominus>" 65)
 where
   "f \<ominus> g = (\<lambda>(x, y). if edge \<Delta> x y then f (x, y) - g (x, y) else if edge \<Delta> y x then g (y, x) - f (y, x) else 0)"
 
 lemma minus_flow_simps [simp]:
   "(f \<ominus> g) (x, y) = (if edge \<Delta> x y then f (x, y) - g (x, y) else if edge \<Delta> y x then g (y, x) - f (y, x) else 0)"
 by(simp add: minus_flow_def)
 
 lemma minus_flow:
   assumes wf: "wf_residual_network"
   and f: "flow \<Delta> f"
   and g: "flow \<Delta> g"
   and value_le: "value_flow \<Delta> g \<le> value_flow \<Delta> f"
   and f_finite: "f (source \<Delta>, x) \<noteq> \<top>"
   and source_out: "\<And>y. edge \<Delta> (source \<Delta>) y \<longleftrightarrow> y = x"
   shows "flow (residual_network g) (f \<ominus> g)" (is "flow ?\<Delta> ?f")
 proof
   show "?f e \<le> capacity ?\<Delta> e" for e
     using value_le f_finite flowD_capacity[OF g] flowD_capacity[OF f]
     by(cases e)(auto simp add: source_in source_out value_flow[OF f source_out] value_flow[OF g source_out] less_top
                      intro!: diff_le_self_ennreal diff_eq_0_ennreal ennreal_minus_mono)
 
   fix x
   assume "x \<noteq> source ?\<Delta>" "x \<noteq> sink ?\<Delta>"
   hence x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>" by simp_all
 
   have finite_f_in: "(\<Sum>\<^sup>+ y. f (y, x) * indicator A y) \<noteq> top" for A
     using flowD_finite_IN[OF f, of x]
     by(rule neq_top_trans)(auto simp add: x d_IN_def split: split_indicator intro!: nn_integral_mono)
   have finite_f_out: "(\<Sum>\<^sup>+ y. f (x, y) * indicator A y) \<noteq> top" for A
     using flowD_finite_OUT[OF f, of x]
     by(rule neq_top_trans)(auto simp add: x d_OUT_def split: split_indicator intro!: nn_integral_mono)
   have finite_f[simp]: "f (x, y) \<noteq> top" "f (y, x) \<noteq> top" for y
     using finite_f_in[of "{y}"] finite_f_out[of "{y}"] by auto
 
   have finite_g_in: "(\<Sum>\<^sup>+ y. g (y, x) * indicator A y) \<noteq> top" for A
     using flowD_finite_IN[OF g, of x]
     by(rule neq_top_trans)(auto simp add: x d_IN_def split: split_indicator intro!: nn_integral_mono)
   have finite_g_out: "(\<Sum>\<^sup>+ y. g (x, y) * indicator A y) \<noteq> top" for A
     using flowD_finite_OUT[OF g x]
     by(rule neq_top_trans)(auto simp add: x d_OUT_def split: split_indicator intro!: nn_integral_mono)
   have finite_g[simp]: "g (x, y) \<noteq> top" "g (y, x) \<noteq> top" for y
     using finite_g_in[of "{y}"] finite_g_out[of "{y}"] by auto
 
   have "d_OUT (f \<ominus> g) x = (\<Sum>\<^sup>+ y. (f (x, y) - g (x, y)) * indicator \<^bold>E (x, y) * indicator {y. g (x, y) \<le> f (x, y)} y) +
     (\<Sum>\<^sup>+ y. (g (y, x) - f (y, x)) * indicator \<^bold>E (y, x) * indicator {y. f (y, x) < g (y, x)} y)"
     (is "_ = ?out + ?in" is "_ = (\<Sum>\<^sup>+ y\<in>_. _ * ?f_ge_g y) + (\<Sum>\<^sup>+ y\<in>_. _ * ?g_gt_f y)")
     using flowD_finite[OF g]
     apply(subst nn_integral_add[symmetric])
     apply(auto 4 4 simp add: d_OUT_def not_le less_top[symmetric] intro!: nn_integral_cong
            dest!: wf_residual_networkD[OF wf] split: split_indicator intro!: diff_eq_0_ennreal)
     done
   also have "?in = (\<Sum>\<^sup>+ y. (g (y, x) - f (y, x)) * ?g_gt_f y)"
     using flowD_outside[OF f] flowD_outside[OF g] by(auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>UNIV. g (y, x) * ?g_gt_f y) - (\<Sum>\<^sup>+ y. f (y, x) * ?g_gt_f y)" (is "_ = ?g_in - ?f_in")
     using finite_f_in
     by(subst nn_integral_diff[symmetric])(auto simp add: AE_count_space split: split_indicator intro!: nn_integral_cong)
   also have "?out = (\<Sum>\<^sup>+ y. (f (x, y) - g (x, y)) * ?f_ge_g y)"
     using flowD_outside[OF f] flowD_outside[OF g] by(auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = (\<Sum>\<^sup>+ y. f (x, y) * ?f_ge_g y) - (\<Sum>\<^sup>+ y. g (x, y) * ?f_ge_g y)" (is "_ = ?f_out - ?g_out")
     using finite_g_out
     by(subst nn_integral_diff[symmetric])(auto simp add: AE_count_space split: split_indicator intro!: nn_integral_cong)
   also have "?f_out = d_OUT f x - (\<Sum>\<^sup>+ y. f (x, y) * indicator {y. f (x, y) < g (x, y)} y)" (is "_ = _ - ?f_out_less")
     unfolding d_OUT_def using flowD_finite[OF f] using finite_f_out
     by(subst nn_integral_diff[symmetric])(auto split: split_indicator intro!: nn_integral_cong)
   also have "?g_out = d_OUT g x - (\<Sum>\<^sup>+ y. g (x, y) * indicator {y. f (x, y) < g (x, y)} y)" (is "_ = _ - ?g_less_f")
     unfolding d_OUT_def using flowD_finite[OF g] finite_g_out
     by(subst nn_integral_diff[symmetric])(auto split: split_indicator intro!: nn_integral_cong)
   also have "d_OUT f x - ?f_out_less - (d_OUT g x - ?g_less_f) + (?g_in - ?f_in) =
     (?g_less_f + (d_OUT f x - ?f_out_less)) - d_OUT g x + (?g_in - ?f_in)"
     by (subst diff_diff_ennreal')
        (auto simp: ac_simps d_OUT_def nn_integral_diff[symmetric] finite_g_out finite_f_out intro!: nn_integral_mono split: split_indicator )
   also have "\<dots> = ?g_less_f + d_OUT f x - ?f_out_less - d_OUT g x + (?g_in - ?f_in)"
     by (subst add_diff_eq_ennreal)
        (auto simp: d_OUT_def intro!: nn_integral_mono split: split_indicator)
   also have "\<dots> = d_OUT f x + ?g_less_f - ?f_out_less - d_OUT g x + (?g_in - ?f_in)"
     by (simp add: ac_simps)
   also have "\<dots> = d_OUT f x + (?g_less_f - ?f_out_less) - d_OUT g x + (?g_in - ?f_in)"
     by (subst add_diff_eq_ennreal[symmetric])
        (auto intro!: nn_integral_mono split: split_indicator)
   also have "\<dots> = (?g_in - ?f_in) + ((?g_less_f - ?f_out_less) + d_OUT f x - d_OUT g x)"
     by (simp add: ac_simps)
   also have "\<dots> = ((?g_in - ?f_in) + ((?g_less_f - ?f_out_less) + d_OUT f x)) - d_OUT g x"
     apply (subst add_diff_eq_ennreal)
     apply (simp_all add: d_OUT_def)
     apply (subst nn_integral_diff[symmetric])
     apply (auto simp: AE_count_space finite_f_out nn_integral_add[symmetric] not_less diff_add_cancel_ennreal intro!: nn_integral_mono split: split_indicator)
     done
   also have "\<dots> = ((?g_less_f - ?f_out_less) + (d_OUT f x + (?g_in - ?f_in))) - d_OUT g x"
     by (simp add: ac_simps)
   also have "\<dots> = ((?g_less_f - ?f_out_less) + (d_IN f x + (?g_in - ?f_in))) - d_IN g x"
     unfolding flowD_KIR[OF f x] flowD_KIR[OF g x] ..
   also have "\<dots> = (?g_less_f - ?f_out_less) + ((d_IN f x + (?g_in - ?f_in)) - d_IN g x)"
     apply (subst (2) add_diff_eq_ennreal)
     apply (simp_all add: d_IN_def)
     apply (subst nn_integral_diff[symmetric])
     apply (auto simp: AE_count_space finite_f_in finite_f_out nn_integral_add[symmetric] not_less  ennreal_ineq_diff_add[symmetric]
                 intro!: nn_integral_mono split: split_indicator)
     done
   also have "\<dots> = (?g_less_f - ?f_out_less) + (d_IN f x + ?g_in - d_IN g x - ?f_in)"
     by (subst (2) add_diff_eq_ennreal) (auto intro!: nn_integral_mono split: split_indicator simp: diff_diff_commute_ennreal)
   also have "\<dots> = (?g_less_f - ?f_out_less) + (d_IN f x - (d_IN g x - ?g_in) - ?f_in)"
     apply (subst diff_diff_ennreal')
     apply (auto simp: d_IN_def intro!: nn_integral_mono split: split_indicator)
     apply (subst nn_integral_diff[symmetric])
     apply (auto simp: AE_count_space finite_g_in intro!: nn_integral_mono split: split_indicator)
     done
   also have "\<dots> =(d_IN f x - ?f_in) - (d_IN g x - ?g_in) + (?g_less_f - ?f_out_less)"
     by (simp add: ac_simps diff_diff_commute_ennreal)
   also have "?g_less_f - ?f_out_less = (\<Sum>\<^sup>+ y. (g (x, y) - f (x, y)) * indicator {y. f (x, y) < g (x, y)} y)" using finite_f_out
     by(subst nn_integral_diff[symmetric])(auto simp add: AE_count_space split: split_indicator intro!: nn_integral_cong)
   also have "\<dots> = (\<Sum>\<^sup>+ y. (g (x, y) - f (x, y)) * indicator \<^bold>E (x, y) * indicator {y. f (x, y) < g (x, y)} y)" (is "_ = ?diff_out")
     using flowD_outside[OF f] flowD_outside[OF g] by(auto intro!: nn_integral_cong split: split_indicator)
   also have "d_IN f x - ?f_in = (\<Sum>\<^sup>+ y. f (y, x) * indicator {y. g (y, x) \<le> f (y, x)} y)"
     unfolding d_IN_def using finite_f_in
     apply(subst nn_integral_diff[symmetric])
     apply(auto simp add: AE_count_space split: split_indicator intro!: nn_integral_cong)
     done
   also have "d_IN g x - ?g_in = (\<Sum>\<^sup>+ y. g (y, x) * indicator {y. g (y, x) \<le> f (y, x)} y)"
     unfolding d_IN_def using finite_g_in
     by(subst nn_integral_diff[symmetric])(auto simp add: flowD_finite[OF g] AE_count_space split: split_indicator intro!: nn_integral_cong)
   also have "(\<Sum>\<^sup>+ y\<in>UNIV. f (y, x) * indicator {y. g (y, x) \<le> f (y, x)} y) - \<dots> = (\<Sum>\<^sup>+ y. (f (y, x) - g (y, x)) * indicator {y. g (y, x) \<le> f (y, x)} y)"
     using finite_g_in
     by(subst nn_integral_diff[symmetric])(auto simp add: flowD_finite[OF g] AE_count_space split: split_indicator intro!: nn_integral_cong)
   also have "\<dots> = (\<Sum>\<^sup>+ y. (f (y, x) - g (y, x)) * indicator \<^bold>E (y, x) * indicator {y. g (y, x) \<le> f (y, x)} y)"
     using flowD_outside[OF f] flowD_outside[OF g] by(auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> + ?diff_out = d_IN ?f x"
     using flowD_finite[OF g]
     apply(subst nn_integral_add[symmetric])
     apply(auto 4 4 simp add: d_IN_def not_le less_top[symmetric] intro!: nn_integral_cong
                dest!: wf_residual_networkD[OF wf] split: split_indicator intro: diff_eq_0_ennreal)
     done
   finally show "KIR ?f x" .
 qed
 
 lemma value_minus_flow:
   assumes f: "flow \<Delta> f"
   and g: "flow \<Delta> g"
   and value_le: "value_flow \<Delta> g \<le> value_flow \<Delta> f"
   and source_out: "\<And>y. edge \<Delta> (source \<Delta>) y \<longleftrightarrow> y = x"
   shows "value_flow \<Delta> (f \<ominus> g) = value_flow \<Delta> f - value_flow \<Delta> g" (is "?value")
 proof -
   have "value_flow \<Delta> (f \<ominus> g) = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T (source \<Delta>). (f \<ominus> g) (source \<Delta>, y))"
     by(subst d_OUT_alt_def)(auto simp add: flowD_outside[OF f] flowD_outside[OF g] source_in)
   also have "\<dots> = (\<Sum>\<^sup>+ y. (f (source \<Delta>, y) - g (source \<Delta>, y)) * indicator {x} y)"
     by(subst nn_integral_count_space_indicator)(auto intro!: nn_integral_cong split: split_indicator simp add: outgoing_def source_out)
   also have "\<dots> = f (source \<Delta>, x) - g (source \<Delta>, x)"
     using value_le value_flow[OF f source_out] value_flow[OF g source_out]
     by(auto simp add: one_ennreal_def[symmetric] max_def not_le intro: antisym)
   also have "\<dots> = value_flow \<Delta> f - value_flow \<Delta> g" using f g source_out by(simp add: value_flow)
   finally show ?value .
 qed
 
 context
   fixes \<alpha>
   defines "\<alpha> \<equiv> (SUP g\<in>{g. flow \<Delta> g}. value_flow \<Delta> g)"
 begin
 
 lemma flow_by_value:
   assumes "v < \<alpha>"
   and real[rule_format]: "\<forall>f. \<alpha> = \<top> \<longrightarrow> flow \<Delta> f \<longrightarrow> value_flow \<Delta> f < \<alpha>"
   obtains f where "flow \<Delta> f" "value_flow \<Delta> f = v"
 proof -
   have \<alpha>_pos: "\<alpha> > 0" using assms by (auto simp add: zero_less_iff_neq_zero)
   from \<open>v < \<alpha>\<close> obtain f where f: "flow \<Delta> f" and v: "v < value_flow \<Delta> f"
     unfolding \<alpha>_def less_SUP_iff by blast
   have [simp]: "value_flow \<Delta> f \<noteq> \<top>"
   proof
     assume val: "value_flow \<Delta> f = \<top>"
     from f have "value_flow \<Delta> f \<le> \<alpha>" unfolding \<alpha>_def by(blast intro: SUP_upper2)
     with val have "\<alpha> = \<top>" by (simp add: top_unique)
     from real[OF this f] val show False by simp
   qed
   let ?f = "\<lambda>e. (v / value_flow \<Delta> f) * f e"
   note f
   moreover
   have *: "0 < value_flow \<Delta> f"
     using \<open>v < value_flow \<Delta> f\<close> by (auto simp add: zero_less_iff_neq_zero)
   then have "v / value_flow \<Delta> f \<le> 1" using v
     by (auto intro!: divide_le_posI_ennreal)
   ultimately have "flow \<Delta> ?f" by (rule scale_flow)
   moreover {
     have "value_flow \<Delta> ?f = v * (value_flow \<Delta> f / value_flow \<Delta> f)"
       by(subst value_scale_flow)(simp add: divide_ennreal_def ac_simps)
     also have "\<dots> = v" using * by(subst ennreal_divide_self) (auto simp: less_top[symmetric])
     also note calculation }
   ultimately show ?thesis by(rule that)
 qed
 
 theorem ex_max_flow':
   assumes wf: "wf_residual_network"
   assumes source_out: "\<And>y. edge \<Delta> (source \<Delta>) y \<longleftrightarrow> y = x"
   and nontrivial: "\<^bold>V - {source \<Delta>, sink \<Delta>} \<noteq> {}"
   and real: "\<alpha> = ennreal \<alpha>'" and \<alpha>'_nonneg[simp]: "0 \<le> \<alpha>'"
   shows "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = \<alpha> \<and> (\<forall>x. d_IN f x \<le> value_flow \<Delta> f)"
 proof -
   have \<alpha>'_not_neg[simp]: "\<not> \<alpha>' < 0"
     using \<alpha>'_nonneg by linarith
 
   let ?v = "\<lambda>i. (1 - (1 / 2) ^ i) * \<alpha>"
   let ?v_r = "\<lambda>i. ennreal ((1 - (1 / 2) ^ i) * \<alpha>')"
   have v_eq: "?v i = ?v_r i" for i
     by (auto simp: real ennreal_mult power_le_one ennreal_lessI ennreal_minus[symmetric]
                    ennreal_power[symmetric] divide_ennreal_def)
   have "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = ?v i" for i :: nat
   proof(cases "\<alpha> = 0")
     case True thus ?thesis by(auto intro!: exI[where x="\<lambda>_. 0"])
   next
     case False
     then have "?v i < \<alpha>"
       unfolding v_eq by (auto simp: real field_simps intro!: ennreal_lessI) (simp_all add: less_le)
     then obtain f where "flow \<Delta> f" and "value_flow \<Delta> f = ?v i"
       by(rule flow_by_value)(simp add: real)
     thus ?thesis by blast
   qed
   then obtain f_aux where f_aux: "\<And>i. flow \<Delta> (f_aux i)"
     and value_aux: "\<And>i. value_flow \<Delta> (f_aux i) = ?v_r i"
     unfolding v_eq by moura
 
   define f_i where "f_i = rec_nat (\<lambda>_. 0) (\<lambda>i f_i.
     let g = f_aux (Suc i) \<ominus> f_i;
       k_i = SOME k. k \<le> g \<and> flow (residual_network f_i) k \<and> value_flow (residual_network f_i) k = value_flow (residual_network f_i) g \<and> (\<forall>x. d_IN k x \<le> value_flow (residual_network f_i) k)
     in f_i \<oplus> k_i)"
   let ?P = "\<lambda>i k. k \<le> f_aux (Suc i) \<ominus> f_i i \<and> flow (residual_network (f_i i)) k \<and> value_flow (residual_network (f_i i)) k = value_flow (residual_network (f_i i)) (f_aux (Suc i) \<ominus> f_i i) \<and> (\<forall>x. d_IN k x \<le> value_flow (residual_network (f_i i)) k)"
   define k_i where "k_i i = Eps (?P i)" for i
 
   have f_i_simps [simp]: "f_i 0 = (\<lambda>_. 0)" "f_i (Suc i) = f_i i \<oplus> k_i i" for i
     by(simp_all add: f_i_def Let_def k_i_def)
 
   have k_i: "flow (residual_network (f_i i)) (k_i i)" (is ?k_i)
     and value_k_i: "value_flow (residual_network (f_i i)) (k_i i) = value_flow (residual_network (f_i i)) (f_aux (Suc i) \<ominus> f_i i)" (is "?value_k_i")
     and IN_k_i: "d_IN (k_i i) x \<le> value_flow (residual_network (f_i i)) (k_i i)" (is "?IN_k_i")
     and value_diff: "value_flow (residual_network (f_i i)) (f_aux (Suc i) \<ominus> f_i i) = value_flow \<Delta> (f_aux (Suc i)) - value_flow \<Delta> (f_i i)" (is "?value_diff")
     if "flow_network \<Delta> (f_i i)" and value_f_i: "value_flow \<Delta> (f_i i) = value_flow \<Delta> (f_aux i)" for i x
   proof -
     let ?RES = "residual_network (f_i i)"
     interpret fn: flow_network \<Delta> "f_i i" by(rule that)
     interpret RES: flow_attainability "?RES" using wf fn.g by(rule residual_flow_attainability)
     have le: "value_flow \<Delta> (f_i i) \<le> value_flow \<Delta> (f_aux (Suc i))"
       unfolding value_aux value_f_i
       unfolding v_eq by (rule ennreal_leI) (auto simp: field_simps)
     with wf f_aux fn.g have res_flow: "flow ?RES (f_aux (Suc i) \<ominus> f_i i)"
       using flowD_finite[OF f_aux] source_out
       by(rule minus_flow)
     show value': ?value_diff by(simp add: value_minus_flow[OF f_aux fn.g le source_out])
     also have "\<dots> < \<top>"
       unfolding value_aux v_eq by (auto simp: less_top[symmetric])
     finally have "value_flow ?RES (f_aux (Suc i) \<ominus> f_i i) \<noteq> \<top>" by simp
     then have fn': "flow_network ?RES (f_aux (Suc i) \<ominus> f_i i)"
       using nontrivial res_flow by(unfold_locales) simp_all
     then interpret fn': flow_network "?RES" "f_aux (Suc i) \<ominus> f_i i" .
     from fn'.flow_cleanup show ?k_i ?value_k_i ?IN_k_i unfolding k_i_def by(rule someI2_ex; blast)+
   qed
 
   have fn_i: "flow_network \<Delta> (f_i i)"
     and value_f_i: "value_flow \<Delta> (f_i i) = value_flow \<Delta> (f_aux i)"
     and d_IN_i: "d_IN (f_i i) x \<le> value_flow \<Delta> (f_i i)"  for i x
   proof(induction i)
     case 0
     { case 1 show ?case using nontrivial by(unfold_locales)(simp_all add: f_aux value_aux) }
     { case 2 show ?case by(simp add: value_aux) }
     { case 3 show ?case by(simp) }
   next
     case (Suc i)
     interpret fn: flow_network \<Delta> "f_i i" using Suc.IH(1) .
     let ?RES = "residual_network (f_i i)"
 
     have k_i: "flow ?RES (k_i i)"
       and value_k_i: "value_flow ?RES (k_i i) = value_flow ?RES (f_aux (Suc i) \<ominus> f_i i)"
       and d_IN_k_i: "d_IN (k_i i) x \<le> value_flow ?RES (k_i i)" for x
       using Suc.IH(1-2) by(rule k_i value_k_i IN_k_i)+
 
     interpret RES: flow_attainability "?RES" using wf fn.g by(rule residual_flow_attainability)
     have le: "value_flow \<Delta> (f_i i) \<le> value_flow \<Delta> (f_aux (Suc i))"
       unfolding value_aux Suc.IH(2) v_eq using \<alpha>'_nonneg by(intro ennreal_leI)(simp add: real field_simps)
     { case 1 show ?case unfolding f_i_simps
       proof
         show "flow \<Delta> (f_i i \<oplus> k_i i)" using wf fn.g k_i by(rule flow_residual_add)
         with RES.flowD_finite[OF k_i] show "value_flow \<Delta> (f_i i \<oplus> k_i i) \<noteq> \<top>"
           by(simp add: value_flow[OF _ source_out])
       qed(rule nontrivial) }
     from value_k_i have value_k: "value_flow ?RES (k_i i) = value_flow \<Delta> (f_aux (Suc i)) - value_flow \<Delta> (f_aux i)"
       by(simp add: value_minus_flow[OF f_aux fn.g le source_out] Suc.IH)
     { case 2 show ?case using value_k
         by(auto simp add: source_out value_plus_flow[OF wf fn.g k_i] Suc.IH value_aux field_simps intro!: ennreal_leI) }
     note value_f = this
     { case 3
       have "d_IN (f_i i \<oplus> k_i i) x \<le> d_IN (f_i i) x + d_IN (k_i i) x"
         using fn.g k_i by(rule d_IN_plus_flow[OF wf])
       also have "\<dots> \<le> value_flow \<Delta> (f_i i) + d_IN (k_i i) x" using Suc.IH(3) by(rule add_right_mono)
       also have "\<dots> \<le> value_flow \<Delta> (f_i i) + value_flow ?RES (k_i i)" using d_IN_k_i by(rule add_left_mono)
       also have "\<dots> = value_flow \<Delta> (f_i (Suc i))" unfolding value_f Suc.IH(2) value_k
         by(auto simp add: value_aux field_simps intro!: ennreal_leI)
       finally show ?case by simp }
   qed
   interpret fn: flow_network \<Delta> "f_i i" for i by(rule fn_i)
   note k_i = k_i[OF fn_i value_f_i] and value_k_i = value_k_i[OF fn_i value_f_i]
     and IN_k_i = IN_k_i[OF fn_i value_f_i] and value_diff = value_diff[OF fn_i value_f_i]
 
   have "\<exists>x\<ge>0. f_i i e = ennreal x" for i e
     using fn.finite_g[of i e] by (cases "f_i i e") auto
   then obtain f_i' where f_i': "\<And>i e. f_i i e = ennreal (f_i' i e)" and [simp]: "\<And>i e. 0 \<le> f_i' i e"
     by metis
 
   { fix i e
     obtain x y :: 'v where e: "e = (x, y)" by(cases e)
     have "k_i i (x, y) \<le> d_IN (k_i i) y" by (rule d_IN_ge_point)
     also have "\<dots> \<le> value_flow (residual_network (f_i i)) (k_i i)" by(rule IN_k_i)
     also have "\<dots> < \<top>" using value_k_i[of i] value_diff[of i]
       by(simp add: value_k_i value_f_i value_aux real less_top[symmetric])
     finally have "\<exists>x\<ge>0. k_i i e = ennreal x"
       by(cases "k_i i e")(auto simp add: e) }
   then obtain k_i' where k_i': "\<And>i e. k_i i e = ennreal (k_i' i e)" and k_i'_nonneg[simp]: "\<And>i e. 0 \<le> k_i' i e"
     by metis
 
   have wf_k: "(x, y) \<in> \<^bold>E \<Longrightarrow> k_i i (y, x) \<le> f_i i (x, y) + k_i i (x, y)" for i x y
     using flowD_capacity[OF k_i, of i "(y, x)"]
     by (auto split: if_split_asm dest: wf_residual_networkD[OF wf] elim: order_trans)
 
   have f_i'_0[simp]: "f_i' 0 = (\<lambda>_. 0)" using f_i_simps(1) by (simp del: f_i_simps add: fun_eq_iff f_i')
 
   have f_i'_Suc[simp]: "f_i' (Suc i) e =  (if e \<in> \<^bold>E then f_i' i e + (k_i' i e - k_i' i (prod.swap e)) else 0)" for i e
     using f_i_simps(2)[of i, unfolded fun_eq_iff, THEN spec, of e] wf_k[of "fst e" "snd e" i]
     by (auto simp del: f_i_simps ennreal_plus
              simp add: fun_eq_iff f_i' k_i' ennreal_plus[symmetric] ennreal_minus split: if_split_asm)
 
   have k_i'_le: "k_i' i e \<le> \<alpha>' / 2 ^ (Suc i)" for i e
   proof -
     obtain x y where e: "e = (x, y)" by(cases e)
     have "k_i' i (x, y) \<le> d_IN (k_i' i) y" by (rule d_IN_ge_point)
     also have "\<dots> \<le> value_flow (residual_network (f_i i)) (k_i' i)"
       using IN_k_i[of i y] by(simp add: k_i'[abs_def])
     also have "\<dots> = \<alpha>' / 2 ^ (Suc i)" using value_k_i[of i] value_diff[of i]
       by(simp add: value_f_i value_aux real k_i'[abs_def] field_simps ennreal_minus mult_le_cancel_left1)
     finally show ?thesis using e by simp
   qed
 
   have convergent: "convergent (\<lambda>i. f_i' i e)" for e
   proof(cases "\<alpha>' > 0")
     case False
     obtain x y where [simp]: "e = (x, y)" by(cases e)
 
     { fix i
       from False \<alpha>'_nonneg have "\<alpha>' = 0" by simp
       moreover have "f_i i (x, y) \<le> d_IN (f_i i) y" by (rule d_IN_ge_point)
       ultimately have "f_i i (x, y) = 0" using d_IN_i[of i y]
         by(simp add: value_f_i value_aux real) }
     thus ?thesis by(simp add: f_i' convergent_const)
   next
     case \<alpha>'_pos: True
     show ?thesis
     proof(rule real_Cauchy_convergent Cauchy_real_Suc_diff)+
       fix n
       have "\<bar>k_i' n e - k_i' n (prod.swap e)\<bar> \<le> \<bar>k_i' n e\<bar> + \<bar>k_i' n (prod.swap e)\<bar>"
         by (rule abs_triangle_ineq4)
       then have "\<bar>k_i' n e - k_i' n (prod.swap e)\<bar> \<le> \<alpha>' / 2 ^ n"
         using k_i'_le[of n e] k_i'_le[of n "prod.swap e"] by simp
       then have "\<bar>f_i' (Suc n) e - f_i' n e\<bar> \<le> \<alpha>' / 2 ^ n"
         using flowD_outside[OF fn.g] by (cases e) (auto simp: f_i')
       thus "\<bar>f_i' (Suc n) e - f_i' n e\<bar> \<le> \<alpha>' / 2 ^ n" by simp
     qed simp
   qed
   then obtain f' where f': "\<And>e. (\<lambda>i. f_i' i e) \<longlonglongrightarrow> f' e" unfolding convergent_def by metis
   hence f: "\<And>e. (\<lambda>i. f_i i e) \<longlonglongrightarrow> ennreal (f' e)" unfolding f_i' by simp
 
   have f'_nonneg: "0 \<le> f' e" for e
     by (rule LIMSEQ_le_const[OF f']) auto
 
   let ?k = "\<lambda>i x y. (k_i' i (x, y) - k_i' i (y, x)) * indicator \<^bold>E (x, y)"
   have sum_i': "f_i' i (x, y) = (\<Sum>j<i. ?k j x y)" for x y i
     by (induction i) auto
 
   have summable_nk: "summable (\<lambda>i. \<bar>?k i x y\<bar>)" for x y
   proof(rule summable_rabs_comparison_test)
     show "\<exists>N. \<forall>i\<ge>N. \<bar>?k i x y\<bar> \<le> \<alpha>' * (1 / 2) ^ i"
     proof (intro exI allI impI)
       fix i have "\<bar>?k i x y\<bar> \<le> k_i' i (x, y) + k_i' i (y, x)"
         by (auto intro!: abs_triangle_ineq4[THEN order_trans] split: split_indicator)
       also have "\<dots> \<le> \<alpha>' * (1 / 2) ^ i"
         using k_i'_le[of i "(x, y)"] k_i'_le[of i "(y, x)"] \<alpha>'_nonneg k_i'_nonneg[of i "(x, y)"] k_i'_nonneg[of i "(y, x)"]
         by(auto simp add: abs_real_def power_divide split: split_indicator)
       finally show "\<bar>?k i x y\<bar> \<le> \<alpha>' * (1 / 2) ^ i"
         by simp
     qed
     show "summable (\<lambda>i. \<alpha>' * (1 / 2) ^ i)"
       by(rule summable_mult complete_algebra_summable_geometric)+ simp
   qed
   hence summable_k: "summable (\<lambda>i. ?k i x y)" for x y by(auto intro: summable_norm_cancel)
 
   have suminf: "(\<Sum>i. (k_i' i (x, y) - k_i' i (y, x)) * indicator \<^bold>E (x, y)) = f' (x, y)" for x y
     by(rule LIMSEQ_unique[OF summable_LIMSEQ])(simp_all add: sum_i'[symmetric] f' summable_k)
 
   have flow: "flow \<Delta> f'"
   proof
     fix e
     have "f' e \<le> Sup {..capacity \<Delta> e}" using _ f
       by(rule Sup_lim)(simp add: flowD_capacity[OF fn.g])
     then show "f' e \<le> capacity \<Delta> e" by simp
   next
     fix x
     assume x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
 
     have integrable_f_i: "integrable (count_space UNIV) (\<lambda>y. f_i' i (x, y))" for i
       using flowD_finite_OUT[OF fn.g x, of i] by(auto intro!: integrableI_bounded simp add: f_i' d_OUT_def less_top)
     have integrable_f_i': "integrable (count_space UNIV) (\<lambda>y. f_i' i (y, x))" for i
       using flowD_finite_IN[OF fn.g, of x i] x by(auto intro!: integrableI_bounded simp add: f_i' d_IN_def less_top)
 
     have integral_k_bounded: "(\<Sum>\<^sup>+ y. norm (?k i x y)) \<le> \<alpha>' / 2 ^ i" (is ?thesis1)
       and integral_k'_bounded: "(\<Sum>\<^sup>+ y. norm (?k i y x)) \<le> \<alpha>' / 2 ^ i" (is ?thesis2) for i
     proof -
       define b where "b = (\<Sum>\<^sup>+ y. k_i i (x, y) + k_i i (y, x))"
       have "b = d_OUT (k_i i) x + d_IN (k_i i) x" unfolding b_def
         by(subst nn_integral_add)(simp_all add: d_OUT_def d_IN_def)
       also have "d_OUT (k_i i) x = d_IN (k_i i) x" using k_i by(rule flowD_KIR)(simp_all add: x)
       also have "\<dots> + \<dots> \<le> value_flow \<Delta> (k_i i) + value_flow \<Delta> (k_i i)"
         using IN_k_i[of i x, simplified] by-(rule add_mono)
       also have "\<dots> \<le> \<alpha>' / 2 ^ i" using value_k_i[of i] value_diff[of i]
         by(simp add: value_aux value_f_i  field_simps ennreal_minus_if ennreal_plus_if mult_le_cancel_left1
                 del: ennreal_plus)
       also have "(\<Sum>\<^sup>+ y\<in>UNIV. norm (?k i x y)) \<le> b" and "(\<Sum>\<^sup>+ y. norm (?k i y x)) \<le> b" unfolding b_def
         by(rule nn_integral_mono; simp add: abs_real_def k_i' ennreal_plus_if del:  ennreal_plus split: split_indicator)+
       ultimately show ?thesis1 ?thesis2 by(auto)
     qed
 
     have integrable_k: "integrable (count_space UNIV) (\<lambda>y. ?k i x y)"
       and integrable_k': "integrable (count_space UNIV) (\<lambda>y. ?k i y x)" for i
       using integral_k_bounded[of i] integral_k'_bounded[of i] real
       by(auto intro!: integrableI_bounded simp: less_top[symmetric] top_unique ennreal_divide_eq_top_iff)
 
     have summable'_k: "summable (\<lambda>i. \<integral> y. \<bar>?k i x y\<bar> \<partial>count_space UNIV)"
     proof(rule summable_comparison_test)
       have "\<bar>\<integral> y. \<bar>?k i x y\<bar> \<partial>count_space UNIV\<bar> \<le> \<alpha>' * (1 / 2) ^ i" for i
         using integral_norm_bound_ennreal[OF integrable_norm, OF integrable_k, of i] integral_k_bounded[of i]
         by(bestsimp simp add: real power_divide dest: order_trans)
       thus "\<exists>N. \<forall>i\<ge>N. norm (\<integral> y. \<bar>?k i x y\<bar> \<partial>count_space UNIV) \<le> \<alpha>' * (1 / 2) ^ i"
         by auto
       show "summable (\<lambda>i. \<alpha>' * (1 / 2) ^ i)"
         by(rule summable_mult complete_algebra_summable_geometric)+ simp
     qed
     have summable'_k': "summable (\<lambda>i. \<integral> y. \<bar>?k i y x\<bar> \<partial>count_space UNIV)"
     proof(rule summable_comparison_test)
       have "\<bar>\<integral> y. \<bar>?k i y x\<bar> \<partial>count_space UNIV\<bar> \<le> \<alpha>' * (1 / 2) ^ i" for i
         using integral_norm_bound_ennreal[OF integrable_norm, OF integrable_k', of i] integral_k'_bounded[of i]
         by(bestsimp simp add: real power_divide dest: order_trans)
       thus "\<exists>N. \<forall>i\<ge>N. norm (\<integral> y. \<bar>?k i y x\<bar> \<partial>count_space UNIV) \<le> \<alpha>' * (1 / 2) ^ i" by auto
       show "summable (\<lambda>i. \<alpha>' * (1 / 2) ^ i)"
         by(rule summable_mult complete_algebra_summable_geometric)+ simp
     qed
 
     have "(\<lambda>i. \<integral> y. ?k i x y \<partial>count_space UNIV) sums \<integral> y. (\<Sum>i. ?k i x y) \<partial>count_space UNIV"
       using integrable_k by(rule sums_integral)(simp_all add: summable_nk summable'_k)
     also have "\<dots> = \<integral> y. f' (x, y) \<partial>count_space UNIV" by(rule Bochner_Integration.integral_cong[OF refl])(rule suminf)
     finally have "(\<lambda>i. \<Sum>j<i. \<integral> y. ?k j x y \<partial>count_space UNIV) \<longlonglongrightarrow> \<dots>" unfolding sums_def .
     also have "(\<lambda>i. \<Sum>j<i. \<integral> y. ?k j x y \<partial>count_space UNIV) = (\<lambda>i. \<integral> y. f_i' i (x, y) \<partial>count_space UNIV)"
       unfolding sum_i' by(rule ext Bochner_Integration.integral_sum[symmetric] integrable_k)+
     finally have "(\<lambda>i. ennreal (\<integral> y. f_i' i (x, y) \<partial>count_space UNIV)) \<longlonglongrightarrow> ennreal (\<integral> y. f' (x, y) \<partial>count_space UNIV)" by simp
     also have "(\<lambda>i. ennreal (\<integral> y. f_i' i (x, y) \<partial>count_space UNIV)) = (\<lambda>i. d_OUT (f_i i) x)"
       unfolding d_OUT_def f_i' by(rule ext nn_integral_eq_integral[symmetric] integrable_f_i)+ simp
     also have "ennreal (\<integral> y. f' (x, y) \<partial>count_space UNIV) = d_OUT f' x"
       unfolding d_OUT_def by(rule nn_integral_eq_integral[symmetric])(simp_all add: f'_nonneg, simp add: suminf[symmetric] integrable_suminf integrable_k summable_nk summable'_k)
     also have "(\<lambda>i. d_OUT (f_i i) x) = (\<lambda>i. d_IN (f_i i) x)"
       using flowD_KIR[OF fn.g x] by(simp)
     finally have *: "(\<lambda>i. d_IN (f_i i) x) \<longlonglongrightarrow> d_OUT (\<lambda>x. ennreal (f' x)) x" .
 
     have "(\<lambda>i. \<integral> y. ?k i y x \<partial>count_space UNIV) sums \<integral> y. (\<Sum>i. ?k i y x) \<partial>count_space UNIV"
       using integrable_k' by(rule sums_integral)(simp_all add: summable_nk summable'_k')
     also have "\<dots> = \<integral> y. f' (y, x) \<partial>count_space UNIV" by(rule Bochner_Integration.integral_cong[OF refl])(rule suminf)
     finally have "(\<lambda>i. \<Sum>j<i. \<integral> y. ?k j y x \<partial>count_space UNIV) \<longlonglongrightarrow> \<dots>" unfolding sums_def .
     also have "(\<lambda>i. \<Sum>j<i. \<integral> y. ?k j y x \<partial>count_space UNIV) = (\<lambda>i. \<integral> y. f_i' i (y, x) \<partial>count_space UNIV)"
       unfolding sum_i' by(rule ext Bochner_Integration.integral_sum[symmetric] integrable_k')+
     finally have "(\<lambda>i. ennreal (\<integral> y. f_i' i (y, x) \<partial>count_space UNIV)) \<longlonglongrightarrow> ennreal (\<integral> y. f' (y, x) \<partial>count_space UNIV)" by simp
     also have "(\<lambda>i. ennreal (\<integral> y. f_i' i (y, x) \<partial>count_space UNIV)) = (\<lambda>i. d_IN (f_i i) x)"
       unfolding d_IN_def f_i' by(rule ext nn_integral_eq_integral[symmetric] integrable_f_i')+ simp
     also have "ennreal (\<integral> y. f' (y, x) \<partial>count_space UNIV) = d_IN f' x"
       unfolding d_IN_def by(rule nn_integral_eq_integral[symmetric])(simp_all add: f'_nonneg, simp add: suminf[symmetric] integrable_suminf integrable_k' summable_nk summable'_k')
     finally show "d_OUT f' x = d_IN f' x" using * by(blast intro: LIMSEQ_unique)
   qed
   moreover
   { have "incseq (\<lambda>i. value_flow \<Delta> (f_i i))"
       by(rule incseq_SucI)(simp add: value_aux value_f_i real field_simps \<alpha>'_nonneg ennreal_leI del: f_i_simps)
     then have "(\<lambda>i. value_flow \<Delta> (f_i i)) \<longlonglongrightarrow> (SUP i. value_flow \<Delta> (f_i i))" by(rule LIMSEQ_SUP)
     also have "(SUP i. value_flow \<Delta> (f_i i)) = \<alpha>"
     proof -
       have "\<alpha> - (SUP i. value_flow \<Delta> (f_i i)) = (INF i. \<alpha> - value_flow \<Delta> (f_i i))"
         by(simp add: ennreal_SUP_const_minus real)
       also have "\<alpha> - value_flow \<Delta> (f_i i) = \<alpha>' / 2 ^ i" for i
         by(simp add: value_f_i value_aux real ennreal_minus_if field_simps mult_le_cancel_left1)
       hence "(INF i. \<alpha> - value_flow \<Delta> (f_i i)) = (INF i. ennreal (\<alpha>' / 2  ^ i))"
         by(auto intro: INF_cong)
       also have "\<dots> = 0"
       proof(rule LIMSEQ_unique)
         show "(\<lambda>i. \<alpha>' / 2 ^ i) \<longlonglongrightarrow> (INF i. ennreal (\<alpha>' / 2  ^ i))"
           by(rule LIMSEQ_INF)(simp add: field_simps real decseq_SucI)
       qed(simp add: LIMSEQ_divide_realpow_zero real ennreal_0[symmetric] del: ennreal_0)
       finally show "(SUP i. value_flow \<Delta> (f_i i)) = \<alpha>"
         apply (intro antisym)
         apply (auto simp: \<alpha>_def intro!: SUP_mono fn.g) []
         apply (rule ennreal_minus_eq_0)
         apply assumption
         done
     qed
     also have "(\<lambda>i. value_flow \<Delta> (f_i i)) \<longlonglongrightarrow> value_flow \<Delta> f'"
       by(simp add: value_flow[OF flow source_out] value_flow[OF fn.g source_out] f)
     ultimately have "value_flow \<Delta> f' = \<alpha>" by(blast intro: LIMSEQ_unique) }
   note value_f = this
   moreover {
     fix x
     have "d_IN f' x = \<integral>\<^sup>+ y. liminf (\<lambda>i. f_i i (y, x)) \<partial>count_space UNIV" unfolding d_IN_def using f
       by(simp add: tendsto_iff_Liminf_eq_Limsup)
     also have "\<dots> \<le> liminf (\<lambda>i. d_IN (f_i i) x)" unfolding d_IN_def
       by(rule nn_integral_liminf)(simp_all add:)
     also have "\<dots> \<le> liminf (\<lambda>i. \<alpha>)" using d_IN_i[of _ x] fn.g
       by(auto intro!: Liminf_mono SUP_upper2 eventually_sequentiallyI simp add: \<alpha>_def)
     also have "\<dots> = value_flow \<Delta> f'" using value_f by(simp add: Liminf_const)
     also note calculation
   } ultimately show ?thesis by blast
 qed
 
 theorem ex_max_flow'': \<comment> \<open>eliminate assumption of no antiparallel edges using locale @{const wf_residual_network}\<close>
   assumes source_out: "\<And>y. edge \<Delta> (source \<Delta>) y \<longleftrightarrow> y = x"
   and nontrivial: "\<^bold>E \<noteq> {}"
   and real: "\<alpha> = ennreal \<alpha>'" and nn[simp]: "0 \<le> \<alpha>'"
   shows "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = \<alpha> \<and> (\<forall>x. d_IN f x \<le> value_flow \<Delta> f)"
 proof -
   interpret antiparallel_edges \<Delta> ..
   interpret \<Delta>'': flow_attainability \<Delta>''
     by(rule \<Delta>''_flow_attainability flow_attainability.axioms(2))+unfold_locales
   have wf_\<Delta>'': "\<Delta>''.wf_residual_network"
     by(rule \<Delta>''_wf_residual_network; simp add: no_loop)
 
   have source_out': "edge \<Delta>'' (source \<Delta>'') y \<longleftrightarrow> y = Edge (source \<Delta>) x" for y
     by(auto simp add: source_out)
   have nontrivial': "\<^bold>V\<^bsub>\<Delta>''\<^esub> - {source \<Delta>'', sink \<Delta>''} \<noteq> {}" using nontrivial by(auto simp add: "\<^bold>V_\<Delta>''")
 
   have "(SUP g \<in> {g. flow \<Delta>'' g}. value_flow \<Delta>'' g) = (SUP g \<in> {g. flow \<Delta> g}. value_flow \<Delta> g)" (is "?lhs = ?rhs")
   proof(intro antisym SUP_least; unfold mem_Collect_eq)
     fix g
     assume g: "flow \<Delta>'' g"
     hence "value_flow \<Delta>'' g = value_flow \<Delta> (collect g)" by(simp add: value_collect)
     also { from g have "flow \<Delta> (collect g)" by simp }
     then have "\<dots> \<le> ?rhs" by(blast intro: SUP_upper2)
     finally show "value_flow \<Delta>'' g \<le> \<dots>" .
   next
     fix g
     assume g: "flow \<Delta> g"
     hence "value_flow \<Delta> g = value_flow \<Delta>'' (split g)" by simp
     also { from g have "flow \<Delta>'' (split g)" by simp }
     then have "\<dots> \<le> ?lhs" by(blast intro: SUP_upper2)
     finally show "value_flow \<Delta> g \<le> ?lhs" .
   qed
   with real have eq: "(SUP g \<in> {g. flow \<Delta>'' g}. value_flow \<Delta>'' g) = ennreal \<alpha>'" by(simp add: \<alpha>_def)
   from \<Delta>''.ex_max_flow'[OF wf_\<Delta>'' source_out' nontrivial' eq]
   obtain f where f: "flow \<Delta>'' f"
     and "value_flow \<Delta>'' f = \<alpha>"
     and IN: "\<And>x. d_IN f x \<le> value_flow \<Delta>'' f" unfolding eq real using nn by blast
   hence "flow \<Delta> (collect f)" and "value_flow \<Delta> (collect f) = \<alpha>" by(simp_all add: value_collect)
   moreover {
     fix x
     have "d_IN (collect f) x = (\<Sum>\<^sup>+ y\<in>range (\<lambda>y. Edge y x). f (y, Vertex x))"
       by(simp add: nn_integral_count_space_reindex d_IN_def)
     also have "\<dots> \<le> d_IN f (Vertex x)" unfolding d_IN_def
       by (auto intro!: nn_integral_mono simp add: nn_integral_count_space_indicator split: split_indicator)
     also have "\<dots> \<le> value_flow \<Delta> (collect f)" using IN[of "Vertex x"] f by(simp add: value_collect)
     also note calculation }
   ultimately show ?thesis by blast
 qed
 
 context begin \<comment> \<open>We eliminate the assumption of only one edge leaving the source by introducing a new source vertex.\<close>
 private datatype (plugins del: transfer size) 'v' node = SOURCE | Inner (inner: 'v')
 
 private lemma not_Inner_conv: "x \<notin> range Inner \<longleftrightarrow> x = SOURCE"
 by(cases x) auto
 
 private lemma inj_on_Inner [simp]: "inj_on Inner A"
 by(simp add: inj_on_def)
 
 private inductive edge' :: "'v node \<Rightarrow> 'v node \<Rightarrow> bool"
 where
   SOURCE: "edge' SOURCE (Inner (source \<Delta>))"
 | Inner: "edge \<Delta> x y \<Longrightarrow> edge' (Inner x) (Inner y)"
 
 private inductive_simps edge'_simps [simp]:
   "edge' SOURCE x"
   "edge' (Inner y) x"
   "edge' y SOURCE"
   "edge' y (Inner x)"
 
 private fun capacity' :: "'v node flow"
 where
   "capacity' (SOURCE, Inner x) = (if x = source \<Delta> then \<alpha> else 0)"
 | "capacity' (Inner x, Inner y) = capacity \<Delta> (x, y)"
 | "capacity' _ = 0"
 
 private lemma capacity'_source_in [simp]: "capacity' (y, Inner (source \<Delta>)) = (if y = SOURCE then \<alpha> else 0)"
 by(cases y)(simp_all add: capacity_outside source_in)
 
 private definition \<Delta>' :: "'v node network"
 where "\<Delta>' = \<lparr>edge = edge', capacity = capacity', source = SOURCE, sink = Inner (sink \<Delta>)\<rparr>"
 
 private lemma \<Delta>'_sel [simp]:
   "edge \<Delta>' = edge'"
   "capacity \<Delta>' = capacity'"
   "source \<Delta>' = SOURCE"
   "sink \<Delta>' = Inner (sink \<Delta>)"
 by(simp_all add: \<Delta>'_def)
 
 private lemma "\<^bold>E_\<Delta>'": "\<^bold>E\<^bsub>\<Delta>'\<^esub> = {(SOURCE, Inner (source \<Delta>))} \<union> (\<lambda>(x, y). (Inner x, Inner y)) ` \<^bold>E"
 by(auto elim: edge'.cases)
 
 private lemma \<Delta>'_countable_network:
   assumes "\<alpha> \<noteq> \<top>"
   shows "countable_network \<Delta>'"
 proof
   show "countable \<^bold>E\<^bsub>\<Delta>'\<^esub>" unfolding "\<^bold>E_\<Delta>'" by simp
   show "source \<Delta>' \<noteq> sink \<Delta>'" by simp
   show "capacity \<Delta>' e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Delta>'\<^esub>" for e using that unfolding "\<^bold>E_\<Delta>'"
     by(cases e rule: capacity'.cases)(auto intro: capacity_outside)
   show "capacity \<Delta>' e \<noteq> \<top>" for e by(cases e rule: capacity'.cases)(simp_all add: assms)
 qed
 
 private lemma \<Delta>'_flow_attainability:
   assumes "\<alpha> \<noteq> \<top>"
   shows "flow_attainability \<Delta>'"
 proof -
   interpret \<Delta>': countable_network \<Delta>' using assms by(rule \<Delta>'_countable_network)
   show ?thesis
   proof
     show "d_IN (capacity \<Delta>') x \<noteq> \<top> \<or> d_OUT (capacity \<Delta>') x \<noteq> \<top>" if sink: "x \<noteq> sink \<Delta>'" for x
     proof(cases x)
       case (Inner x')
       consider (source) "x' = source \<Delta>" | (IN) "x' \<noteq> source \<Delta>" "d_IN (capacity \<Delta>) x' \<noteq> \<top>" | (OUT) "d_OUT (capacity \<Delta>) x' \<noteq> \<top>"
         using finite_capacity[of x'] sink Inner by(auto)
       thus ?thesis
       proof(cases)
         case source
         with Inner have "d_IN (capacity \<Delta>') x = (\<Sum>\<^sup>+ y. \<alpha> * indicator {SOURCE :: 'v node} y)"
           unfolding d_IN_def by(intro nn_integral_cong)(simp split: split_indicator)
         also have "\<dots> = \<alpha>" by(simp add: max_def)
         finally show ?thesis using assms by simp
       next
         case IN
         with Inner have "d_IN (capacity \<Delta>') x = (\<Sum>\<^sup>+ y\<in>range Inner. capacity \<Delta> (node.inner y, x'))"
           by(auto simp add: d_IN_def nn_integral_count_space_indicator not_Inner_conv intro!: nn_integral_cong split: split_indicator)
         also have "\<dots> = d_IN (capacity \<Delta>) x'" unfolding d_IN_def
           by(simp add: nn_integral_count_space_reindex)
         finally show ?thesis using Inner sink IN by(simp)
       next
         case OUT
         from Inner have "d_OUT (capacity \<Delta>') x = (\<Sum>\<^sup>+ y\<in>range Inner. capacity \<Delta> (x', node.inner y))"
           by(auto simp add: d_OUT_def nn_integral_count_space_indicator not_Inner_conv intro!: nn_integral_cong split: split_indicator)
         also have "\<dots> = d_OUT (capacity \<Delta>) x'" by(simp add: d_OUT_def nn_integral_count_space_reindex)
         finally show ?thesis using OUT by auto
       qed
     qed(simp add: d_IN_def)
     show "\<not> edge \<Delta>' x x" for x by(cases x)(simp_all add: no_loop)
     show "\<not> edge \<Delta>' x (source \<Delta>')" for x by simp
   qed
 qed
 
 private fun lift :: "'v flow \<Rightarrow> 'v node flow"
 where
   "lift f (SOURCE, Inner y) = (if y = source \<Delta> then value_flow \<Delta> f else 0)"
 | "lift f (Inner x, Inner y) = f (x, y)"
 | "lift f _ = 0"
 
 private lemma d_OUT_lift_Inner [simp]: "d_OUT (lift f) (Inner x) = d_OUT f x" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>\<^sup>+ y\<in>range Inner. lift f (Inner x, y))"
     by(auto simp add: d_OUT_def nn_integral_count_space_indicator not_Inner_conv intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = ?rhs" by(simp add: nn_integral_count_space_reindex d_OUT_def)
   finally show ?thesis .
 qed
 
 private lemma d_OUT_lift_SOURCE [simp]: "d_OUT (lift f) SOURCE = value_flow \<Delta> f" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>\<^sup>+ y. lift f (SOURCE, y) * indicator {Inner (source \<Delta>)} y)"
     unfolding d_OUT_def by(rule nn_integral_cong)(case_tac x; simp)
   also have "\<dots> = ?rhs" by(simp add: nn_integral_count_space_indicator max_def)
   finally show ?thesis .
 qed
 
 private lemma d_IN_lift_Inner [simp]:
   assumes "x \<noteq> source \<Delta>"
   shows "d_IN (lift f) (Inner x) = d_IN f x" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>\<^sup>+ y\<in>range Inner. lift f (y, Inner x))" using assms
     by(auto simp add: d_IN_def nn_integral_count_space_indicator not_Inner_conv intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = ?rhs" by(simp add: nn_integral_count_space_reindex d_IN_def)
   finally show ?thesis .
 qed
 
 private lemma d_IN_lift_source [simp]: "d_IN (lift f) (Inner (source \<Delta>)) = value_flow \<Delta> f + d_IN f (source \<Delta>)" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>\<^sup>+ y. lift f (y, Inner (source \<Delta>)) * indicator {SOURCE} y) + (\<Sum>\<^sup>+ y\<in>range Inner. lift f (y, Inner (source \<Delta>)))"
     (is "_ = ?SOURCE + ?rest")
     unfolding d_IN_def
     apply(subst nn_integral_count_space_indicator, simp)
     apply(subst nn_integral_add[symmetric])
     apply(auto simp add: AE_count_space max_def not_Inner_conv split: split_indicator intro!: nn_integral_cong)
     done
   also have "?rest = d_IN f (source \<Delta>)" by(simp add: nn_integral_count_space_reindex d_IN_def)
   also have "?SOURCE = value_flow \<Delta> f"
     by(simp add: max_def one_ennreal_def[symmetric] )
   finally show ?thesis .
 qed
 
 private lemma flow_lift [simp]:
   assumes "flow \<Delta> f"
   shows "flow \<Delta>' (lift f)"
 proof
   show "lift f e \<le> capacity \<Delta>' e" for e
     by(cases e rule: capacity'.cases)(auto intro: flowD_capacity[OF assms] simp add: \<alpha>_def intro: SUP_upper2 assms)
 
   fix x
   assume x: "x \<noteq> source \<Delta>'" "x \<noteq> sink \<Delta>'"
   then obtain x' where x': "x = Inner x'" by(cases x) auto
   then show "KIR (lift f) x" using x
     by(cases "x' = source \<Delta>")(auto simp add: flowD_source_IN[OF assms] dest: flowD_KIR[OF assms])
 qed
 
 private abbreviation (input) unlift :: "'v node flow \<Rightarrow> 'v flow"
 where "unlift f \<equiv> (\<lambda>(x, y). f (Inner x, Inner y))"
 
 private lemma flow_unlift [simp]:
   assumes f: "flow \<Delta>' f"
   shows "flow \<Delta> (unlift f)"
 proof
   show "unlift f e \<le> capacity \<Delta> e" for e using flowD_capacity[OF f, of "map_prod Inner Inner e"]
     by(cases e)(simp)
 next
   fix x
   assume x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
   have "d_OUT (unlift f) x = (\<Sum>\<^sup>+ y\<in>range Inner. f (Inner x, y))"
     by(simp add: nn_integral_count_space_reindex d_OUT_def)
   also have "\<dots> = d_OUT f (Inner x)" using flowD_capacity[OF f, of "(Inner x, SOURCE)"]
     by(auto simp add: nn_integral_count_space_indicator d_OUT_def not_Inner_conv intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = d_IN f (Inner x)" using x flowD_KIR[OF f, of "Inner x"] by(simp)
   also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. f (y, Inner x))"
     using x flowD_capacity[OF f, of "(SOURCE, Inner x)"]
     by(auto simp add: nn_integral_count_space_indicator d_IN_def not_Inner_conv intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = d_IN (unlift f) x" by(simp add: nn_integral_count_space_reindex d_IN_def)
   finally show "KIR (unlift f) x" .
 qed
 
 private lemma value_unlift:
   assumes f: "flow \<Delta>' f"
   shows "value_flow \<Delta> (unlift f) = value_flow \<Delta>' f"
 proof -
   have "value_flow \<Delta> (unlift f) = (\<Sum>\<^sup>+ y\<in>range Inner. f (Inner (source \<Delta>), y))"
     by(simp add: nn_integral_count_space_reindex d_OUT_def)
   also have "\<dots> = d_OUT f (Inner (source \<Delta>))" using flowD_capacity[OF f, of "(Inner (source \<Delta>), SOURCE)"]
     by(auto simp add: nn_integral_count_space_indicator d_OUT_def not_Inner_conv intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = d_IN f (Inner (source \<Delta>))" using flowD_KIR[OF f, of "Inner (source \<Delta>)"] by(simp)
   also have "\<dots> = (\<Sum>\<^sup>+ y. f (y, Inner (source \<Delta>)) * indicator {SOURCE} y)"
     unfolding d_IN_def using flowD_capacity[OF f, of "(x, Inner (source \<Delta>))" for x]
     by(intro nn_integral_cong)(auto intro!: antisym split: split_indicator if_split_asm elim: meta_allE)
   also have "\<dots> = f (SOURCE, Inner (source \<Delta>))" by simp
   also have "\<dots> = (\<Sum>\<^sup>+ y. f (SOURCE, y) * indicator {Inner (source \<Delta>)} y)"
     by(simp add: one_ennreal_def[symmetric])
   also have "\<dots> = value_flow \<Delta>' f" unfolding d_OUT_def
     unfolding d_OUT_def using flowD_capacity[OF f, of "(SOURCE, Inner x)" for x] flowD_capacity[OF f, of "(SOURCE, SOURCE)"]
     apply(intro nn_integral_cong)
     apply(case_tac x)
     apply(auto intro!: antisym split: split_indicator if_split_asm elim: meta_allE)
     done
   finally show ?thesis .
 qed
 
 theorem ex_max_flow:
   "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = \<alpha> \<and> (\<forall>x. d_IN f x \<le> value_flow \<Delta> f)"
 proof(cases "\<alpha>")
   case (real \<alpha>')
   hence \<alpha>: "\<alpha> \<noteq> \<top>" by simp
   then interpret \<Delta>': flow_attainability \<Delta>' by(rule \<Delta>'_flow_attainability)
 
   have source_out: "edge \<Delta>' (source \<Delta>') y \<longleftrightarrow> y = Inner (source \<Delta>)" for y by(auto)
   have nontrivial: "\<^bold>E\<^bsub>\<Delta>'\<^esub> \<noteq> {}" by(auto intro: edge'.intros)
 
   have eq: "(SUP g \<in> {g. flow \<Delta>' g}. value_flow \<Delta>' g) = (SUP g \<in> {g. flow \<Delta> g}. value_flow \<Delta> g)" (is "?lhs = ?rhs")
   proof(intro antisym SUP_least; unfold mem_Collect_eq)
     fix g
     assume g: "flow \<Delta>' g"
     hence "value_flow \<Delta>' g = value_flow \<Delta> (unlift g)" by(simp add: value_unlift)
     also { from g have "flow \<Delta> (unlift g)" by simp }
     then have "\<dots> \<le> ?rhs" by(blast intro: SUP_upper2)
     finally show "value_flow \<Delta>' g \<le> \<dots>" .
   next
     fix g
     assume g: "flow \<Delta> g"
     hence "value_flow \<Delta> g = value_flow \<Delta>' (lift g)" by simp
     also { from g have "flow \<Delta>' (lift g)" by simp }
     then have "\<dots> \<le> ?lhs" by(blast intro: SUP_upper2)
     finally show "value_flow \<Delta> g \<le> ?lhs" .
   qed
   also have "\<dots> = ennreal \<alpha>'" using real by(simp add: \<alpha>_def)
   finally obtain f where f: "flow \<Delta>' f"
     and value_f: "value_flow \<Delta>' f = (\<Squnion>g\<in>{g. flow \<Delta>' g}. value_flow \<Delta>' g)"
     and IN_f: "\<And>x. d_IN f x \<le> value_flow \<Delta>' f"
     using \<open>0 \<le> \<alpha>'\<close> by(blast dest: \<Delta>'.ex_max_flow''[OF source_out nontrivial])
   have "flow \<Delta> (unlift f)" using f by simp
   moreover have "value_flow \<Delta> (unlift f) = \<alpha>" using f eq value_f by(simp add: value_unlift \<alpha>_def)
   moreover {
     fix x
     have "d_IN (unlift f) x = (\<Sum>\<^sup>+ y\<in>range Inner. f (y, Inner x))"
       by(simp add: nn_integral_count_space_reindex d_IN_def)
     also have "\<dots> \<le> d_IN f (Inner x)" unfolding d_IN_def
       by(auto intro!: nn_integral_mono simp add: nn_integral_count_space_indicator split: split_indicator)
     also have "\<dots> \<le> value_flow \<Delta> (unlift f)" using IN_f[of "Inner x"] f by(simp add: value_unlift)
     also note calculation }
   ultimately show ?thesis by blast
 next
   case top
   show ?thesis
   proof(cases "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = \<top>")
     case True
     with top show ?thesis by auto
   next
     case False
     hence real: "\<forall>f. \<alpha> = \<top> \<longrightarrow> flow \<Delta> f \<longrightarrow> value_flow \<Delta> f < \<alpha>" using top by (auto simp: less_top)
     { fix i
       have "2 * 2 ^ i < \<alpha>" using top by (simp_all add: ennreal_mult_less_top power_less_top_ennreal)
       from flow_by_value[OF this real] have "\<exists>f. flow \<Delta> f \<and> value_flow \<Delta> f = 2 * 2 ^ i" by blast }
     then obtain f_i where f_i: "\<And>i. flow \<Delta> (f_i i)"
       and value_i: "\<And>i. value_flow \<Delta> (f_i i) = 2 * 2 ^ i" by metis
     define f where "f e = (\<Sum>\<^sup>+ i. f_i i e / (2 * 2 ^ i))" for e
     have "flow \<Delta> f"
     proof
       fix e
       have "f e \<le> (\<Sum>\<^sup>+ i. (SUP i. f_i i e) / (2 * 2 ^ i))" unfolding f_def
         by(rule nn_integral_mono)(auto intro!: divide_right_mono_ennreal SUP_upper)
       also have "\<dots> = (SUP i. f_i i e) / 2 * (\<Sum>\<^sup>+ i. 1 / 2 ^ i)"
         apply(subst nn_integral_cmult[symmetric])
         apply(auto intro!: nn_integral_cong intro: SUP_upper2
           simp: divide_ennreal_def ennreal_inverse_mult power_less_top_ennreal mult_ac)
         done
       also have "(\<Sum>\<^sup>+ i. 1 / 2 ^ i) = (\<Sum>i. ennreal ((1 / 2) ^ i))"
         by(simp add: nn_integral_count_space_nat power_divide divide_ennreal[symmetric] ennreal_power[symmetric])
       also have "\<dots> = ennreal (\<Sum>i. (1 / 2) ^ i)"
         by(intro suminf_ennreal2 complete_algebra_summable_geometric) simp_all
       also have "\<dots> = 2" by(subst suminf_geometric; simp)
       also have "(SUP i. f_i i e) / 2 * 2 = (SUP i. f_i i e)"
         by (simp add: ennreal_divide_times)
       also have "\<dots> \<le> capacity \<Delta> e" by(rule SUP_least)(rule flowD_capacity[OF f_i])
       finally show "f e \<le> capacity \<Delta> e" .
 
       fix x
       assume x: "x \<noteq> source \<Delta>" "x \<noteq> sink \<Delta>"
       have "d_OUT f x = (\<Sum>\<^sup>+ i\<in>UNIV. \<Sum>\<^sup>+ y. f_i i (x, y) / (2 * 2 ^ i))"
         unfolding d_OUT_def f_def
         by(subst nn_integral_snd_count_space[where f="case_prod _", simplified])
           (simp add: nn_integral_fst_count_space[where f="case_prod _", simplified])
       also have "\<dots> = (\<Sum>\<^sup>+ i. d_OUT (f_i i) x / (2 * 2 ^ i))" unfolding d_OUT_def
         by(simp add: nn_integral_divide)
       also have "\<dots> = (\<Sum>\<^sup>+ i. d_IN (f_i i) x / (2 * 2 ^ i))" by(simp add: flowD_KIR[OF f_i, OF x])
       also have "\<dots> = (\<Sum>\<^sup>+ i\<in>UNIV. \<Sum>\<^sup>+ y. f_i i (y, x) / (2 * 2 ^ i))"
         by(simp add: nn_integral_divide d_IN_def)
       also have "\<dots> = d_IN f x" unfolding d_IN_def f_def
         by(subst nn_integral_snd_count_space[where f="case_prod _", simplified])
           (simp add: nn_integral_fst_count_space[where f="case_prod _", simplified])
       finally show "KIR f x" .
     qed
     moreover {
       have "value_flow \<Delta> f = (\<Sum>\<^sup>+ i. value_flow \<Delta> (f_i i) / (2 * 2 ^ i))"
         unfolding d_OUT_def f_def
         by(subst nn_integral_snd_count_space[where f="case_prod _", simplified])
           (simp add: nn_integral_fst_count_space[where f="case_prod _", simplified] nn_integral_divide[symmetric])
       also have "\<dots> = \<top>"
         by(simp add: value_i ennreal_mult_less_top power_less_top_ennreal)
       finally have "value_flow \<Delta> f = \<top>" .
     }
     ultimately show ?thesis using top by auto
   qed
 qed
 
 end
 
 end
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/MFMC_Countable/MFMC_Unbounded.thy b/thys/MFMC_Countable/MFMC_Unbounded.thy
--- a/thys/MFMC_Countable/MFMC_Unbounded.thy
+++ b/thys/MFMC_Countable/MFMC_Unbounded.thy
@@ -1,3467 +1,3467 @@
 (* Author: Andreas Lochbihler, ETH Zurich *)
 
 section \<open>The max-flow min-cut theorems in unbounded networks\<close>
 
 theory MFMC_Unbounded imports
   MFMC_Web
   MFMC_Flow_Attainability
   MFMC_Reduction
 begin
 
 subsection \<open>More about waves\<close>
 
 lemma SINK_plus_current: "SINK (plus_current f g) = SINK f \<inter> SINK g"
 by(auto simp add: SINK.simps set_eq_iff d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0 add_eq_0_iff_both_eq_0)
 
 abbreviation plus_web :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v current \<Rightarrow> 'v current" ("_ \<frown>\<index> _" [66, 66] 65)
 where "plus_web \<Gamma> f g \<equiv> plus_current f (g \<upharpoonleft> \<Gamma> / f)"
 
 lemma d_OUT_plus_web:
   fixes \<Gamma> (structure)
   shows "d_OUT (f \<frown> g) x = d_OUT f x + d_OUT (g \<upharpoonleft> \<Gamma> / f) x" (is "?lhs = ?rhs")
 proof -
   have "?lhs = d_OUT f x + (\<Sum>\<^sup>+ y. (if x \<in> RF\<^sup>\<circ> (TER f) then 0 else g (x, y) * indicator (- RF (TER f)) y))"
     unfolding d_OUT_def by(subst nn_integral_add[symmetric])(auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = ?rhs" by(auto simp add: d_OUT_def intro!: arg_cong2[where f="(+)"] nn_integral_cong)
   finally show "?thesis" .
 qed
 
 lemma d_IN_plus_web:
   fixes \<Gamma> (structure)
   shows "d_IN (f \<frown> g) y = d_IN f y + d_IN (g \<upharpoonleft> \<Gamma> / f) y" (is "?lhs = ?rhs")
 proof -
   have "?lhs = d_IN f y + (\<Sum>\<^sup>+ x. (if y \<in> RF (TER f) then 0 else g (x, y) * indicator (- RF\<^sup>\<circ> (TER f)) x))"
     unfolding d_IN_def by(subst nn_integral_add[symmetric])(auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = ?rhs" by(auto simp add: d_IN_def intro!: arg_cong2[where f="(+)"] nn_integral_cong)
   finally show ?thesis .
 qed
 
 lemma plus_web_greater: "f e \<le> (f \<frown>\<^bsub>\<Gamma>\<^esub> g) e"
 by(cases e)(auto split: split_indicator)
 
 lemma current_plus_web:
   fixes \<Gamma> (structure)
   shows "\<lbrakk> current \<Gamma> f; wave \<Gamma> f; current \<Gamma> g \<rbrakk> \<Longrightarrow> current \<Gamma> (f \<frown> g)"
 by(blast intro: current_plus_current current_restrict_current)
 
 context
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure)
   and f g :: "'v current"
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
 begin
 
 context
   fixes x :: "'v"
   assumes x: "x \<in> \<E> (TER f \<union> TER g)"
 begin
 
 qualified lemma RF_f: "x \<notin> RF\<^sup>\<circ> (TER f)"
 proof
   assume *: "x \<in> RF\<^sup>\<circ> (TER f)"
 
   from x obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     and bypass: "\<And>z. \<lbrakk>x \<noteq> y; z \<in> set p\<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> TER f \<union> TER g" by(rule \<E>_E) blast
   from rtrancl_path_distinct[OF p] obtain p'
     where p: "path \<Gamma> x p' y" and p': "set p' \<subseteq> set p" and distinct: "distinct (x # p')" .
 
   from * have x': "x \<in> RF (TER f)" and \<E>: "x \<notin> \<E> (TER f)" by(auto simp add: roofed_circ_def)
   hence "x \<notin> TER f" using not_essentialD[OF _ p y] p' bypass by blast
   with roofedD[OF x' p y] obtain z where z: "z \<in> set p'" "z \<in> TER f" by auto
   with p have "y \<in> set p'" by(auto dest!: rtrancl_path_last intro: last_in_set)
   with distinct have "x \<noteq> y" by auto
   with bypass z p' distinct show False by auto
 qed
 
 private lemma RF_g: "x \<notin> RF\<^sup>\<circ> (TER g)"
 proof
   assume *: "x \<in> RF\<^sup>\<circ> (TER g)"
 
   from x obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     and bypass: "\<And>z. \<lbrakk>x \<noteq> y; z \<in> set p\<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> TER f \<union> TER g" by(rule \<E>_E) blast
   from rtrancl_path_distinct[OF p] obtain p'
     where p: "path \<Gamma> x p' y" and p': "set p' \<subseteq> set p" and distinct: "distinct (x # p')" .
 
   from * have x': "x \<in> RF (TER g)" and \<E>: "x \<notin> \<E> (TER g)" by(auto simp add: roofed_circ_def)
   hence "x \<notin> TER g" using not_essentialD[OF _ p y] p' bypass by blast
   with roofedD[OF x' p y] obtain z where z: "z \<in> set p'" "z \<in> TER g" by auto
   with p have "y \<in> set p'" by(auto dest!: rtrancl_path_last intro: last_in_set)
   with distinct have "x \<noteq> y" by auto
   with bypass z p' distinct show False by auto
 qed
 
 lemma TER_plus_web_aux:
   assumes SINK: "x \<in> SINK (g \<upharpoonleft> \<Gamma> / f)" (is "_ \<in> SINK ?g")
   shows "x \<in> TER (f \<frown> g)"
 proof
   from x obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     and bypass: "\<And>z. \<lbrakk>x \<noteq> y; z \<in> set p\<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> TER f \<union> TER g" by(rule \<E>_E) blast
   from rtrancl_path_distinct[OF p] obtain p'
     where p: "path \<Gamma> x p' y" and p': "set p' \<subseteq> set p" and distinct: "distinct (x # p')" .
 
   from RF_f have "x \<in> SINK f"
     by(auto simp add: roofed_circ_def SINK.simps dest: waveD_OUT[OF w])
   thus "x \<in> SINK (f \<frown> g)" using SINK
     by(simp add: SINK.simps d_OUT_plus_web)
   show "x \<in> SAT \<Gamma> (f \<frown> g)"
   proof(cases "x \<in> TER f")
     case True
     hence "x \<in> SAT \<Gamma> f" by simp
     moreover have "\<dots> \<subseteq> SAT \<Gamma> (f \<frown> g)" by(rule SAT_mono plus_web_greater)+
     ultimately show ?thesis by blast
   next
     case False
     with x have "x \<in> TER g" by auto
     from False RF_f have "x \<notin> RF (TER f)" by(auto simp add: roofed_circ_def)
     moreover { fix z
       assume z: "z \<in> RF\<^sup>\<circ> (TER f)"
       have "(z, x) \<notin> \<^bold>E"
       proof
         assume "(z, x) \<in> \<^bold>E"
         hence path': "path \<Gamma> z (x # p') y" using p by(simp add: rtrancl_path.step)
         from z have "z \<in> RF (TER f)" by(simp add: roofed_circ_def)
         from roofedD[OF this path' y] False
         consider (path) z' where  "z' \<in> set p'" "z' \<in> TER f" | (TER) "z \<in> TER f" by auto
         then show False
         proof cases
           { case (path z')
             with p distinct have "x \<noteq> y"
               by(auto 4 3 intro: last_in_set elim: rtrancl_path.cases dest: rtrancl_path_last[symmetric])
             from bypass[OF this, of z'] path False p' show False by auto }
           note that = this
           case TER
           with z have "\<not> essential \<Gamma> (B \<Gamma>) (TER f) z" by(simp add: roofed_circ_def)
           from not_essentialD[OF this path' y] False obtain z' where "z' \<in> set p'" "z' \<in> TER f" by auto
           thus False by(rule that)
         qed
       qed }
     ultimately have "d_IN ?g x = d_IN g x" unfolding d_IN_def
       by(intro nn_integral_cong)(clarsimp split: split_indicator simp add: currentD_outside[OF g])
     hence "d_IN (f \<frown> g) x \<ge> d_IN g x"
       by(simp add: d_IN_plus_web)
     with \<open>x \<in> TER g\<close> show ?thesis by(auto elim!: SAT.cases intro: SAT.intros)
   qed
 qed
 
 qualified lemma SINK_TER_in'':
   assumes "\<And>x. x \<notin> RF (TER g) \<Longrightarrow> d_OUT g x = 0"
   shows "x \<in> SINK g"
 using RF_g by(auto simp add: roofed_circ_def SINK.simps assms)
 
 end
 
 lemma wave_plus: "wave (quotient_web \<Gamma> f) (g \<upharpoonleft> \<Gamma> / f) \<Longrightarrow> wave \<Gamma> (f \<frown> g)"
 using f w by(rule wave_plus_current)(rule current_restrict_current[OF w g])
 
 lemma TER_plus_web'':
   assumes "\<And>x. x \<notin> RF (TER g) \<Longrightarrow> d_OUT g x = 0"
   shows "\<E> (TER f \<union> TER g) \<subseteq> TER (f \<frown> g)"
 proof
   fix x
   assume *: "x \<in> \<E> (TER f \<union> TER g)"
   moreover have "x \<in> SINK (g \<upharpoonleft> \<Gamma> / f)"
     by(rule in_SINK_restrict_current)(rule MFMC_Unbounded.SINK_TER_in''[OF f w g * assms])
   ultimately show "x \<in> TER (f \<frown> g)" by(rule TER_plus_web_aux)
 qed
 
 lemma TER_plus_web': "wave \<Gamma> g \<Longrightarrow> \<E> (TER f \<union> TER g) \<subseteq> TER (f \<frown> g)"
 by(rule TER_plus_web'')(rule waveD_OUT)
 
 lemma wave_plus': "wave \<Gamma> g \<Longrightarrow> wave \<Gamma> (f \<frown> g)"
 by(rule wave_plus)(rule wave_restrict_current[OF f w g])
 
 end
 
 lemma RF_TER_plus_web:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
   and w': "wave \<Gamma> g"
   shows "RF (TER (f \<frown> g)) = RF (TER f \<union> TER g)"
 proof
   have "RF (\<E> (TER f \<union> TER g)) \<subseteq> RF (TER (f \<frown> g))"
     by(rule roofed_mono)(rule TER_plus_web'[OF f w g w'])
   also have "RF (\<E> (TER f \<union> TER g)) = RF (TER f \<union> TER g)" by(rule RF_essential)
   finally show "\<dots> \<subseteq> RF (TER (f \<frown> g))" .
 next
   have fg: "current \<Gamma> (f \<frown> g)" using f w g by(rule current_plus_web)
   show "RF (TER (f \<frown> g)) \<subseteq> RF (TER f \<union> TER g)"
   proof(intro subsetI roofedI)
     fix x p y
     assume RF: "x \<in> RF (TER (f \<frown> g))" and p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     from roofedD[OF RF p y] obtain z where z: "z \<in> set (x # p)" and TER: "z \<in> TER (f \<frown> g)" by auto
     from TER have SINK: "z \<in> SINK f"
       by(auto simp add: SINK.simps d_OUT_plus_web add_eq_0_iff_both_eq_0)
     from TER have "z \<in> SAT \<Gamma> (f \<frown> g)" by simp
     hence SAT: "z \<in> SAT \<Gamma> f \<union> SAT \<Gamma> g"
       by(cases "z \<in> RF (TER f)")(auto simp add: currentD_SAT[OF f] currentD_SAT[OF g] currentD_SAT[OF fg] d_IN_plus_web d_IN_restrict_current_outside restrict_current_IN_not_RF[OF g] wave_not_RF_IN_zero[OF f w])
 
     show "(\<exists>z\<in>set p. z \<in> TER f \<union> TER g) \<or> x \<in> TER f \<union> TER g"
     proof(cases "z \<in> RF (TER g)")
       case False
       hence "z \<in> SINK g" by(simp add: SINK.simps waveD_OUT[OF w'])
       with SINK SAT have "z \<in> TER f \<union> TER g" by auto
       thus ?thesis using z by auto
     next
       case True
       from split_list[OF z] obtain ys zs where split: "x # p = ys @ z # zs" by blast
       with p have "path \<Gamma> z zs y" by(auto elim: rtrancl_path_appendE simp add: Cons_eq_append_conv)
       from roofedD[OF True this y] split show ?thesis by(auto simp add: Cons_eq_append_conv)
     qed
   qed
 qed
 
 lemma RF_TER_Sup:
   fixes \<Gamma> (structure)
   assumes f: "\<And>f. f \<in> Y \<Longrightarrow> current \<Gamma> f"
   and w: "\<And>f. f \<in> Y \<Longrightarrow> wave \<Gamma> f"
   and Y: "Complete_Partial_Order.chain (\<le>) Y" "Y \<noteq> {}" "countable (support_flow (Sup Y))"
   shows "RF (TER (Sup Y)) = RF (\<Union>f\<in>Y. TER f)"
 proof(rule set_eqI iffI)+
   fix x
   assume x: "x \<in> RF (TER (Sup Y))"
   have "x \<in> RF (RF (\<Union>f\<in>Y. TER f))"
   proof
     fix p y
     assume p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     from roofedD[OF x p y] obtain z where z: "z \<in> set (x # p)" and TER: "z \<in> TER (Sup Y)" by auto
     from TER have SINK: "z \<in> SINK f" if "f \<in> Y" for f using that by(auto simp add: SINK_Sup[OF Y])
 
     from Y(2) obtain f where y: "f \<in> Y" by blast
 
     show "(\<exists>z\<in>set p. z \<in> RF (\<Union>f\<in>Y. TER f)) \<or> x \<in> RF (\<Union>f\<in>Y. TER f)"
     proof(cases "\<exists>f\<in>Y. z \<in> RF (TER f)")
       case True
       then obtain f where fY: "f \<in> Y" and zf: "z \<in> RF (TER f)" by blast
       from zf have "z \<in> RF (\<Union>f\<in>Y. TER f)" by(rule in_roofed_mono)(auto intro: fY)
       with z show ?thesis by auto
     next
       case False
       hence *: "d_IN f z = 0" if "f \<in> Y" for f using that by(auto intro: wave_not_RF_IN_zero[OF f w])
       hence "d_IN (Sup Y) z = 0" using Y(2) by(simp add: d_IN_Sup[OF Y])
       with TER have "z \<in> SAT \<Gamma> f" using *[OF y]
         by(simp add: SAT.simps)
       with SINK[OF y] have "z \<in> TER f" by simp
       with z y show ?thesis by(auto intro: roofed_greaterI)
     qed
   qed
   then show "x \<in> RF (\<Union>f\<in>Y. TER f)" unfolding roofed_idem .
 next
   fix x
   assume x: "x \<in> RF (\<Union>f\<in>Y. TER f)"
   have "x \<in> RF (RF (TER (\<Squnion>Y)))"
   proof(rule roofedI)
     fix p y
     assume p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     from roofedD[OF x p y] obtain z f where *: "z \<in> set (x # p)"
       and **: "f \<in> Y" and TER: "z \<in> TER f" by auto
     have "z \<in> RF (TER (Sup Y))"
     proof(rule ccontr)
       assume z: "z \<notin> RF (TER (Sup Y))"
       have "wave \<Gamma> (Sup Y)" using Y(1-2) w Y(3) by(rule wave_lub)
       hence "d_OUT (Sup Y) z = 0" using z by(rule waveD_OUT)
       hence "z \<in> SINK (Sup Y)" by(simp add: SINK.simps)
       moreover have "z \<in> SAT \<Gamma> (Sup Y)" using TER SAT_Sup_upper[OF **, of \<Gamma>] by blast
       ultimately have "z \<in> TER (Sup Y)" by simp
       hence "z \<in> RF (TER (Sup Y))" by(rule roofed_greaterI)
       with z show False by contradiction
     qed
     thus "(\<exists>z\<in>set p. z \<in> RF (TER (Sup Y))) \<or> x \<in> RF (TER (Sup Y))" using * by auto
   qed
   then show "x \<in> RF (TER (\<Squnion>Y))" unfolding roofed_idem .
 qed
 
 subsection \<open>Hindered webs with reduced weights\<close>
 
 context countable_bipartite_web begin
 
 context
   fixes u :: "'v \<Rightarrow> ennreal"
   and \<epsilon>
   defines "\<epsilon> \<equiv> (\<integral>\<^sup>+ y. u y \<partial>count_space (B \<Gamma>))"
   assumes u_outside: "\<And>x. x \<notin> B \<Gamma> \<Longrightarrow> u x = 0"
   and finite_\<epsilon>: "\<epsilon> \<noteq> \<top>"
 begin
 
 private lemma u_A: "x \<in> A \<Gamma> \<Longrightarrow> u x = 0"
 using u_outside[of x] disjoint by auto
 
 private lemma u_finite: "u y \<noteq> \<top>"
 proof(cases "y \<in> B \<Gamma>")
   case True
   have "u y \<le> \<epsilon>" unfolding \<epsilon>_def by(rule nn_integral_ge_point)(simp add: True)
   also have "\<dots> < \<top>" using finite_\<epsilon> by (simp add: less_top[symmetric])
   finally show ?thesis by simp
 qed(simp add: u_outside)
 
 lemma hindered_reduce: \<comment> \<open>Lemma 6.7\<close>
   assumes u: "u \<le> weight \<Gamma>"
   assumes hindered_by: "hindered_by (\<Gamma>\<lparr>weight := weight \<Gamma> - u\<rparr>) \<epsilon>" (is "hindered_by ?\<Gamma> _")
   shows "hindered \<Gamma>"
 proof -
   note [simp] = u_finite
   let ?TER = "TER\<^bsub>?\<Gamma>\<^esub>"
   from hindered_by obtain f
     where hindrance_by: "hindrance_by ?\<Gamma> f \<epsilon>"
     and f: "current ?\<Gamma> f"
     and w: "wave ?\<Gamma> f" by cases
   from hindrance_by obtain a where a: "a \<in> A \<Gamma>" "a \<notin> \<E>\<^bsub>?\<Gamma>\<^esub> (?TER f)"
     and a_le: "d_OUT f a < weight \<Gamma> a"
     and \<epsilon>_less: "weight \<Gamma> a - d_OUT f a > \<epsilon>"
     and \<epsilon>_nonneg: "\<epsilon> \<ge> 0" by(auto simp add: u_A hindrance_by.simps)
 
   from f have f': "current \<Gamma> f" by(rule current_weight_mono)(auto intro: diff_le_self_ennreal)
 
   write Some ("\<langle>_\<rangle>")
 
   define edge'
     where "edge' xo yo =
       (case (xo, yo) of
         (None, Some y) \<Rightarrow> y \<in> \<^bold>V \<and> y \<notin> A \<Gamma>
       | (Some x, Some y) \<Rightarrow> edge \<Gamma> x y \<or> edge \<Gamma> y x
       | _ \<Rightarrow> False)" for xo yo
   define cap
     where "cap e =
       (case e of
         (None, Some y) \<Rightarrow> if y \<in> \<^bold>V then u y else 0
       | (Some x, Some y) \<Rightarrow> if edge \<Gamma> x y \<and> x \<noteq> a then f (x, y) else if edge \<Gamma> y x then max (weight \<Gamma> x) (weight \<Gamma> y) + 1 else 0
       | _ \<Rightarrow> 0)" for e
   define \<Psi> where "\<Psi> = \<lparr>edge = edge', capacity = cap, source = None, sink = Some a\<rparr>"
 
   have edge'_simps [simp]:
     "edge' None \<langle>y\<rangle> \<longleftrightarrow> y \<in> \<^bold>V \<and> y \<notin> A \<Gamma>"
     "edge' xo None \<longleftrightarrow> False"
     "edge' \<langle>x\<rangle> \<langle>y\<rangle> \<longleftrightarrow> edge \<Gamma> x y \<or> edge \<Gamma> y x"
     for xo x y by(simp_all add: edge'_def split: option.split)
 
   have edge_None1E [elim!]: thesis if "edge' None y" "\<And>z. \<lbrakk> y = \<langle>z\<rangle>; z \<in> \<^bold>V; z \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis" for y thesis
     using that by(simp add: edge'_def split: option.split_asm sum.split_asm)
   have edge_Some1E [elim!]: thesis if "edge' \<langle>x\<rangle> y" "\<And>z. \<lbrakk> y = \<langle>z\<rangle>; edge \<Gamma> x z \<or> edge \<Gamma> z x \<rbrakk> \<Longrightarrow> thesis" for x y thesis
     using that by(simp add: edge'_def split: option.split_asm sum.split_asm)
   have edge_Some2E [elim!]: thesis if "edge' x \<langle>y\<rangle>" "\<lbrakk> x = None; y \<in> \<^bold>V; y \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis" "\<And>z. \<lbrakk> x = \<langle>z\<rangle>; edge \<Gamma> z y \<or> edge \<Gamma> y z \<rbrakk> \<Longrightarrow> thesis" for x y thesis
     using that by(simp add: edge'_def split: option.split_asm sum.split_asm)
 
   have cap_simps [simp]:
     "cap (None, \<langle>y\<rangle>) = (if y \<in> \<^bold>V then u y else 0)"
     "cap (xo, None) = 0"
     "cap (\<langle>x\<rangle>, \<langle>y\<rangle>) =
     (if edge \<Gamma> x y \<and> x \<noteq> a then f (x, y) else if edge \<Gamma> y x then max (weight \<Gamma> x) (weight \<Gamma> y) + 1 else 0)"
     for xo x y by(simp_all add: cap_def split: option.split)
 
   have \<Psi>_sel [simp]:
     "edge \<Psi> = edge'"
     "capacity \<Psi> = cap"
     "source \<Psi> = None"
     "sink \<Psi> = \<langle>a\<rangle>"
     by(simp_all add: \<Psi>_def)
 
   have cap_outside1: "\<not> vertex \<Gamma> x \<Longrightarrow> cap (\<langle>x\<rangle>, y) = 0" for x y
     by(cases y)(auto simp add: vertex_def)
   have capacity_A_weight: "d_OUT cap \<langle>x\<rangle> \<le> weight \<Gamma> x" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_OUT cap \<langle>x\<rangle> \<le> (\<Sum>\<^sup>+ y\<in>range Some. f (x, the y))"
       using that disjoint a(1) unfolding d_OUT_def
       by(auto 4 4 intro!: nn_integral_mono simp add: nn_integral_count_space_indicator notin_range_Some currentD_outside[OF f] split: split_indicator dest: edge_antiparallel bipartite_E)
     also have "\<dots> = d_OUT f x" by(simp add: d_OUT_def nn_integral_count_space_reindex)
     also have "\<dots> \<le> weight \<Gamma> x" using f' by(rule currentD_weight_OUT)
     finally show ?thesis .
   qed
   have flow_attainability: "flow_attainability \<Psi>"
   proof
     have "\<^bold>E\<^bsub>\<Psi>\<^esub> = (\<lambda>(x, y). (\<langle>x\<rangle>, \<langle>y\<rangle>)) ` \<^bold>E \<union> (\<lambda>(x, y). (\<langle>y\<rangle>, \<langle>x\<rangle>)) ` \<^bold>E \<union> (\<lambda>x. (None, \<langle>x\<rangle>)) ` (\<^bold>V \<inter> - A \<Gamma>)"
       by(auto simp add: edge'_def split: option.split_asm)
     thus "countable \<^bold>E\<^bsub>\<Psi>\<^esub>" by simp
   next
     fix v
     assume "v \<noteq> sink \<Psi>"
     consider (sink) "v = None" | (A) x where "v = \<langle>x\<rangle>" "x \<in> A \<Gamma>"
       | (B) y where "v = \<langle>y\<rangle>" "y \<notin> A \<Gamma>" "y \<in> \<^bold>V" | (outside) x where "v = \<langle>x\<rangle>" "x \<notin> \<^bold>V"
       by(cases v) auto
     then show "d_IN (capacity \<Psi>) v \<noteq> \<top> \<or> d_OUT (capacity \<Psi>) v \<noteq> \<top>"
     proof cases
       case sink thus ?thesis by(simp add: d_IN_def)
     next
       case (A x)
       thus ?thesis using capacity_A_weight[of x] by (auto simp: top_unique)
     next
       case (B y)
       have "d_IN (capacity \<Psi>) v \<le> (\<Sum>\<^sup>+ x. f (the x, y) * indicator (range Some) x + u y * indicator {None} x)"
         using B disjoint bipartite_V a(1) unfolding d_IN_def
         by(auto 4 4 intro!: nn_integral_mono simp add: nn_integral_count_space_indicator notin_range_Some currentD_outside[OF f] split: split_indicator dest: edge_antiparallel bipartite_E)
       also have "\<dots> = (\<Sum>\<^sup>+ x\<in>range Some. f (the x, y)) + u y"
         by(subst nn_integral_add)(simp_all add: nn_integral_count_space_indicator)
       also have "\<dots> = d_IN f y + u y" by(simp add: d_IN_def nn_integral_count_space_reindex)
       also have "d_IN f y \<le> weight \<Gamma> y" using f' by(rule currentD_weight_IN)
       finally show ?thesis by(auto simp add: add_right_mono top_unique split: if_split_asm)
     next
       case outside
       hence "d_OUT (capacity \<Psi>) v = 0"
         by(auto simp add: d_OUT_def nn_integral_0_iff_AE AE_count_space cap_def vertex_def split: option.split)
       thus ?thesis by simp
     qed
   next
     show "capacity \<Psi> e \<noteq> \<top>" for e using weight_finite
       by(auto simp add: cap_def max_def vertex_def currentD_finite[OF f'] split: option.split prod.split simp del: weight_finite)
     show "capacity \<Psi> e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Psi>\<^esub>" for e
       using that bipartite_V disjoint
       by(auto simp add: cap_def max_def intro: u_outside split: option.split prod.split)
     show "\<not> edge \<Psi> x (source \<Psi>)" for x  by simp
     show "\<not> edge \<Psi> x x" for x by(cases x)(simp_all add: no_loop)
     show "source \<Psi> \<noteq> sink \<Psi>" by simp
   qed
   then interpret \<Psi>: flow_attainability "\<Psi>" .
 
   define \<alpha> where "\<alpha> = (\<Squnion>g\<in>{g. flow \<Psi> g}. value_flow \<Psi> g)"
   have \<alpha>_le: "\<alpha> \<le> \<epsilon>"
   proof -
     have "\<alpha> \<le> d_OUT cap None" unfolding \<alpha>_def by(rule SUP_least)(auto intro!: d_OUT_mono dest: flowD_capacity)
     also have "\<dots> \<le> \<integral>\<^sup>+ y. cap (None, y) \<partial>count_space (range Some)" unfolding d_OUT_def
       by(auto simp add: nn_integral_count_space_indicator notin_range_Some intro!: nn_integral_mono split: split_indicator)
     also have "\<dots> \<le> \<epsilon>" unfolding \<epsilon>_def
       by (subst (2) nn_integral_count_space_indicator, auto simp add: nn_integral_count_space_reindex u_outside intro!: nn_integral_mono split: split_indicator)
     finally show ?thesis by simp
   qed
   then have finite_flow: "\<alpha> \<noteq> \<top>" using finite_\<epsilon> by (auto simp: top_unique)
 
   from \<Psi>.ex_max_flow
   obtain j where j: "flow \<Psi> j"
     and value_j: "value_flow \<Psi> j = \<alpha>"
     and IN_j: "\<And>x. d_IN j x \<le> \<alpha>"
     unfolding \<alpha>_def by auto
 
   have j_le_f: "j (Some x, Some y) \<le> f (x, y)" if "edge \<Gamma> x y" for x y
     using that flowD_capacity[OF j, of "(Some x, Some y)"] a(1) disjoint
     by(auto split: if_split_asm dest: bipartite_E intro: order_trans)
 
   have IN_j_finite [simp]: "d_IN j x \<noteq> \<top>" for x using finite_flow by(rule neq_top_trans)(simp add: IN_j)
 
   have j_finite[simp]: "j (x, y) < \<top>" for x y
     by (rule le_less_trans[OF d_IN_ge_point]) (simp add: IN_j_finite[of y] less_top[symmetric])
 
   have OUT_j_finite: "d_OUT j x \<noteq> \<top>" for x
   proof(cases "x = source \<Psi> \<or> x = sink \<Psi>")
     case True thus ?thesis
     proof cases
       case left thus ?thesis using finite_flow value_j by simp
     next
       case right
       have "d_OUT (capacity \<Psi>) \<langle>a\<rangle> \<noteq> \<top>" using capacity_A_weight[of a] a(1) by(auto simp: top_unique)
       thus ?thesis unfolding right[simplified]
         by(rule neq_top_trans)(rule d_OUT_mono flowD_capacity[OF j])+
     qed
   next
     case False then show ?thesis by(simp add: flowD_KIR[OF j])
   qed
 
   have IN_j_le_weight: "d_IN j \<langle>x\<rangle> \<le> weight \<Gamma> x" for x
   proof(cases "x \<in> A \<Gamma>")
     case xA: True
     show ?thesis
     proof(cases "x = a")
       case True
       have "d_IN j \<langle>x\<rangle> \<le> \<alpha>" by(rule IN_j)
       also have "\<dots> \<le> \<epsilon>" by(rule \<alpha>_le)
       also have "\<epsilon> < weight \<Gamma> a" using \<epsilon>_less diff_le_self_ennreal less_le_trans by blast
       finally show ?thesis using True by(auto intro: order.strict_implies_order)
     next
       case False
       have "d_IN j \<langle>x\<rangle> = d_OUT j \<langle>x\<rangle>" using flowD_KIR[OF j, of "Some x"] False by simp
       also have "\<dots> \<le> d_OUT cap \<langle>x\<rangle>" using flowD_capacity[OF j] by(auto intro: d_OUT_mono)
       also have "\<dots> \<le> weight \<Gamma> x" using xA  by(rule capacity_A_weight)
       finally show ?thesis .
     qed
   next
     case xA: False
     show ?thesis
     proof(cases "x \<in> B \<Gamma>")
       case True
       have "d_IN j \<langle>x\<rangle> \<le> d_IN cap \<langle>x\<rangle>" using flowD_capacity[OF j] by(auto intro: d_IN_mono)
       also have "\<dots> \<le> (\<Sum>\<^sup>+ z. f (the z, x) * indicator (range Some) z) + (\<Sum>\<^sup>+ z :: 'v option. u x * indicator {None} z)"
         using True disjoint
         by(subst nn_integral_add[symmetric])(auto simp add: vertex_def currentD_outside[OF f] d_IN_def B_out intro!: nn_integral_mono split: split_indicator)
       also have "\<dots> = d_IN f x + u x"
         by(simp add: nn_integral_count_space_indicator[symmetric] nn_integral_count_space_reindex d_IN_def)
       also have "\<dots> \<le> weight \<Gamma> x" using currentD_weight_IN[OF f, of x] u_finite[of x]
         using \<epsilon>_less u by (auto simp add: ennreal_le_minus_iff le_fun_def)
       finally show ?thesis .
     next
       case False
       with xA have "x \<notin> \<^bold>V" using bipartite_V by blast
       then have "d_IN j \<langle>x\<rangle> = 0" using False
         by(auto simp add: d_IN_def nn_integral_0_iff emeasure_count_space_eq_0 vertex_def edge'_def split: option.split_asm intro!: \<Psi>.flowD_outside[OF j])
       then show ?thesis
         by simp
     qed
   qed
 
   let ?j = "j \<circ> map_prod Some Some \<circ> prod.swap"
 
   have finite_j_OUT: "(\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. j (\<langle>x\<rangle>, \<langle>y\<rangle>)) \<noteq> \<top>" (is "?j_OUT \<noteq> _") if "x \<in> A \<Gamma>" for x
     using currentD_finite_OUT[OF f', of x]
     by(rule neq_top_trans)(auto intro!: nn_integral_mono j_le_f simp add: d_OUT_def nn_integral_count_space_indicator outgoing_def split: split_indicator)
   have j_OUT_eq: "?j_OUT x = d_OUT j \<langle>x\<rangle>" if "x \<in> A \<Gamma>" for x
   proof -
     have "?j_OUT x = (\<Sum>\<^sup>+ y\<in>range Some. j (Some x, y))" using that disjoint
       by(simp add: nn_integral_count_space_reindex)(auto 4 4 simp add: nn_integral_count_space_indicator outgoing_def intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] dest: bipartite_E split: split_indicator)
     also have "\<dots> = d_OUT j \<langle>x\<rangle>"
       by(auto simp add: d_OUT_def nn_integral_count_space_indicator notin_range_Some intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] split: split_indicator)
     finally show ?thesis .
   qed
 
   define g where "g = f \<oplus> ?j"
   have g_simps: "g (x, y) = (f \<oplus> ?j) (x, y)" for x y by(simp add: g_def)
 
   have OUT_g_A: "d_OUT g x = d_OUT f x + d_IN j \<langle>x\<rangle> - d_OUT j \<langle>x\<rangle>" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_OUT g x = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. f (x, y) + j (\<langle>y\<rangle>, \<langle>x\<rangle>) - j (\<langle>x\<rangle>, \<langle>y\<rangle>))"
       by(auto simp add: d_OUT_def g_simps currentD_outside[OF f'] outgoing_def nn_integral_count_space_indicator intro!: nn_integral_cong)
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. f (x, y) + j (\<langle>y\<rangle>, \<langle>x\<rangle>)) - (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. j (\<langle>x\<rangle>, \<langle>y\<rangle>))"
       (is "_ = _ - ?j_OUT") using finite_j_OUT[OF that]
       by(subst nn_integral_diff)(auto simp add: AE_count_space outgoing_def intro!: order_trans[OF j_le_f])
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. f (x, y)) + (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. j (Some y, Some x)) - ?j_OUT"
       (is "_ = ?f + ?j_IN - _") by(subst nn_integral_add) simp_all
     also have "?f = d_OUT f x" by(subst d_OUT_alt_def[where G=\<Gamma>])(simp_all add: currentD_outside[OF f])
     also have "?j_OUT = d_OUT j \<langle>x\<rangle>" using that by(rule j_OUT_eq)
     also have "?j_IN = (\<Sum>\<^sup>+ y\<in>range Some. j (y, \<langle>x\<rangle>))" using that disjoint
       by(simp add: nn_integral_count_space_reindex)(auto 4 4 simp add: nn_integral_count_space_indicator outgoing_def intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] split: split_indicator dest: bipartite_E)
     also have "\<dots> = d_IN j (Some x)" using that disjoint
       by(auto 4 3 simp add: d_IN_def nn_integral_count_space_indicator notin_range_Some intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] split: split_indicator)
     finally show ?thesis by simp
   qed
 
   have OUT_g_B: "d_OUT g x = 0" if "x \<notin> A \<Gamma>" for x
     using disjoint that
     by(auto simp add: d_OUT_def nn_integral_0_iff_AE AE_count_space g_simps dest: bipartite_E)
 
   have OUT_g_a: "d_OUT g a < weight \<Gamma> a" using a(1)
   proof -
     have "d_OUT g a = d_OUT f a + d_IN j \<langle>a\<rangle> - d_OUT j \<langle>a\<rangle>" using a(1) by(rule OUT_g_A)
     also have "\<dots> \<le> d_OUT f a + d_IN j \<langle>a\<rangle>"
       by(rule diff_le_self_ennreal)
     also have "\<dots> < weight \<Gamma> a + d_IN j \<langle>a\<rangle> - \<epsilon>"
       using finite_\<epsilon> \<epsilon>_less currentD_finite_OUT[OF f']
       by (simp add: less_diff_eq_ennreal less_top ac_simps)
     also have "\<dots> \<le> weight \<Gamma> a"
       using IN_j[THEN order_trans, OF \<alpha>_le] by (simp add: ennreal_minus_le_iff)
     finally show ?thesis .
   qed
 
   have OUT_jj: "d_OUT ?j x = d_IN j \<langle>x\<rangle> - j (None, \<langle>x\<rangle>)" for x
   proof -
     have "d_OUT ?j x = (\<Sum>\<^sup>+ y\<in>range Some. j (y, \<langle>x\<rangle>))" by(simp add: d_OUT_def nn_integral_count_space_reindex)
     also have "\<dots> = d_IN j \<langle>x\<rangle> - (\<Sum>\<^sup>+ y. j (y, \<langle>x\<rangle>) * indicator {None} y)" unfolding d_IN_def
       by(subst nn_integral_diff[symmetric])(auto simp add: max_def \<Psi>.flowD_finite[OF j] AE_count_space nn_integral_count_space_indicator split: split_indicator intro!: nn_integral_cong)
     also have "\<dots> = d_IN j \<langle>x\<rangle> - j (None, \<langle>x\<rangle>)" by(simp add: max_def)
     finally show ?thesis .
   qed
 
   have OUT_jj_finite [simp]: "d_OUT ?j x \<noteq> \<top>" for x
     by(simp add: OUT_jj)
 
   have IN_g: "d_IN g x = d_IN f x + j (None, \<langle>x\<rangle>)" for x
   proof(cases "x \<in> B \<Gamma>")
     case True
     have finite: "(\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. j (Some y, Some x)) \<noteq> \<top>" using currentD_finite_IN[OF f', of x]
       by(rule neq_top_trans)(auto intro!: nn_integral_mono j_le_f simp add: d_IN_def nn_integral_count_space_indicator incoming_def split: split_indicator)
 
     have "d_IN g x = d_IN (f \<oplus> ?j) x" by(simp add: g_def)
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. f (y, x) + j (Some x, Some y) - j (Some y, Some x))"
       by(auto simp add: d_IN_def currentD_outside[OF f'] incoming_def nn_integral_count_space_indicator intro!: nn_integral_cong)
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. f (y, x) + j (Some x, Some y)) - (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. j (Some y, Some x))"
       (is "_ = _ - ?j_IN") using finite
       by(subst nn_integral_diff)(auto simp add: AE_count_space incoming_def intro!: order_trans[OF j_le_f])
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. f (y, x)) + (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. j (Some x, Some y)) - ?j_IN"
       (is "_ = ?f + ?j_OUT - _") by(subst nn_integral_add) simp_all
     also have "?f = d_IN f x" by(subst d_IN_alt_def[where G=\<Gamma>])(simp_all add: currentD_outside[OF f])
     also have "?j_OUT = (\<Sum>\<^sup>+ y\<in>range Some. j (Some x, y))" using True disjoint
       by(simp add: nn_integral_count_space_reindex)(auto 4 4 simp add: nn_integral_count_space_indicator incoming_def intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] split: split_indicator dest: bipartite_E)
     also have "\<dots> = d_OUT j (Some x)" using disjoint
       by(auto 4 3 simp add: d_OUT_def nn_integral_count_space_indicator notin_range_Some intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] split: split_indicator)
     also have "\<dots> = d_IN j (Some x)" using flowD_KIR[OF j, of "Some x"] True a disjoint by auto
     also have "?j_IN = (\<Sum>\<^sup>+ y\<in>range Some. j (y, Some x))" using True disjoint
       by(simp add: nn_integral_count_space_reindex)(auto 4 4 simp add: nn_integral_count_space_indicator incoming_def intro!: nn_integral_cong \<Psi>.flowD_outside[OF j] dest: bipartite_E split: split_indicator)
     also have "\<dots> = d_IN j (Some x) - (\<Sum>\<^sup>+ y :: 'v option. j (None, Some x) * indicator {None} y)"
       unfolding d_IN_def using flowD_capacity[OF j, of "(None, Some x)"]
       by(subst nn_integral_diff[symmetric])
         (auto simp add: nn_integral_count_space_indicator AE_count_space top_unique image_iff
               intro!: nn_integral_cong ennreal_diff_self split: split_indicator if_split_asm)
     also have "d_IN f x + d_IN j (Some x) - \<dots> = d_IN f x + j (None, Some x)"
       using ennreal_add_diff_cancel_right[OF IN_j_finite[of "Some x"], of "d_IN f x + j (None, Some x)"]
       apply(subst diff_diff_ennreal')
       apply(auto simp add: d_IN_def intro!: nn_integral_ge_point ennreal_diff_le_mono_left)
       apply(simp add: ac_simps)
       done
     finally show ?thesis .
   next
     case False
     hence "d_IN g x = 0" "d_IN f x = 0" "j (None, \<langle>x\<rangle>) = 0"
       using disjoint currentD_IN[OF f', of x] bipartite_V currentD_outside_IN[OF f'] u_outside[OF False] flowD_capacity[OF j, of "(None, \<langle>x\<rangle>)"]
       by(cases "vertex \<Gamma> x"; auto simp add: d_IN_def nn_integral_0_iff_AE AE_count_space g_simps dest: bipartite_E split: if_split_asm)+
     thus ?thesis by simp
   qed
 
   have g: "current \<Gamma> g"
   proof
     show "d_OUT g x \<le> weight \<Gamma> x" for x
     proof(cases "x \<in> A \<Gamma>")
       case False
       thus ?thesis by(simp add: OUT_g_B)
     next
       case True
       with OUT_g_a show ?thesis
         by(cases "x = a")(simp_all add: OUT_g_A flowD_KIR[OF j] currentD_weight_OUT[OF f'])
     qed
 
     show "d_IN g x \<le> weight \<Gamma> x" for x
     proof(cases "x \<in> B \<Gamma>")
       case False
       hence "d_IN g x = 0" using disjoint
         by(auto simp add: d_IN_def nn_integral_0_iff_AE AE_count_space g_simps dest: bipartite_E)
       thus ?thesis by simp
     next
       case True
       have "d_IN g x \<le> (weight \<Gamma> x - u x) + u x" unfolding IN_g
         using currentD_weight_IN[OF f, of x] flowD_capacity[OF j, of "(None, Some x)"] True bipartite_V
         by(intro add_mono)(simp_all split: if_split_asm)
       also have "\<dots> = weight \<Gamma> x"
         using u by (intro diff_add_cancel_ennreal) (simp add: le_fun_def)
       finally show ?thesis .
     qed
     show "g e = 0" if "e \<notin> \<^bold>E" for e using that
       by(cases e)(auto simp add: g_simps)
   qed
 
   define cap' where "cap' = (\<lambda>(x, y). if edge \<Gamma> x y then g (x, y) else if edge \<Gamma> y x then 1 else 0)"
 
   have cap'_simps [simp]: "cap' (x, y) = (if edge \<Gamma> x y then g (x, y) else if edge \<Gamma> y x then 1 else 0)"
     for x y by(simp add: cap'_def)
 
   define G where "G = \<lparr>edge = \<lambda>x y. cap' (x, y) > 0\<rparr>"
   have G_sel [simp]: "edge G x y \<longleftrightarrow> cap' (x, y) > 0" for x y by(simp add: G_def)
   define reachable where "reachable x = (edge G)\<^sup>*\<^sup>* x a" for x
   have reachable_alt_def: "reachable \<equiv> \<lambda>x. \<exists>p. path G x p a"
     by(simp add: reachable_def [abs_def] rtranclp_eq_rtrancl_path)
 
   have [simp]: "reachable a" by(auto simp add: reachable_def)
 
   have AB_edge: "edge G x y" if "edge \<Gamma> y x" for x y
     using that
     by(auto dest: edge_antiparallel simp add: min_def le_neq_trans add_eq_0_iff_both_eq_0)
   have reachable_AB: "reachable y" if "reachable x" "(x, y) \<in> \<^bold>E" for x y
     using that by(auto simp add: reachable_def simp del: G_sel dest!: AB_edge intro: rtrancl_path.step)
   have reachable_BA: "g (x, y) = 0" if "reachable y" "(x, y) \<in> \<^bold>E" "\<not> reachable x" for x y
   proof(rule ccontr)
     assume "g (x, y) \<noteq> 0"
     then have "g (x, y) > 0" by (simp add: zero_less_iff_neq_zero)
     hence "edge G x y" using that by simp
     then have "reachable x" using \<open>reachable y\<close>
       unfolding reachable_def by(rule converse_rtranclp_into_rtranclp)
     with \<open>\<not> reachable x\<close> show False by contradiction
   qed
   have reachable_V: "vertex \<Gamma> x" if "reachable x" for x
   proof -
     from that obtain p where p: "path G x p a" unfolding reachable_alt_def ..
     then show ?thesis using rtrancl_path_nth[OF p, of 0] a(1) A_vertex
       by(cases "p = []")(auto 4 3 simp add: vertex_def elim: rtrancl_path.cases split: if_split_asm)
   qed
 
   have finite_j_IN: "(\<integral>\<^sup>+ y. j (Some y, Some x) \<partial>count_space (\<^bold>I\<^bold>N x)) \<noteq> \<top>" for x
   proof -
     have "(\<integral>\<^sup>+ y. j (Some y, Some x) \<partial>count_space (\<^bold>I\<^bold>N x)) \<le> d_IN f x"
       by(auto intro!: nn_integral_mono j_le_f simp add: d_IN_def nn_integral_count_space_indicator incoming_def split: split_indicator)
     thus ?thesis using currentD_finite_IN[OF f', of x] by (auto simp: top_unique)
   qed
   have j_outside: "j (x, y) = 0" if "\<not> edge \<Psi> x y" for x y
     using that flowD_capacity[OF j, of "(x, y)"] \<Psi>.capacity_outside[of "(x, y)"]
     by(auto)
 
   define h where "h = (\<lambda>(x, y). if reachable x \<and> reachable y then g (x, y) else 0)"
   have h_simps [simp]: "h (x, y) = (if reachable x \<and> reachable y then g (x, y) else 0)" for x y
     by(simp add: h_def)
   have h_le_g: "h e \<le> g e" for e by(cases e) simp
 
   have OUT_h: "d_OUT h x = (if reachable x then d_OUT g x else 0)" for x
   proof -
     have "d_OUT h x = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. h (x, y))" using h_le_g currentD_outside[OF g]
       by(intro d_OUT_alt_def) auto
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>O\<^bold>U\<^bold>T x. if reachable x then g (x, y) else 0)"
       by(auto intro!: nn_integral_cong simp add: outgoing_def dest: reachable_AB)
     also have "\<dots> = (if reachable x then d_OUT g x else 0)"
       by(auto intro!: d_OUT_alt_def[symmetric] currentD_outside[OF g])
     finally show ?thesis .
   qed
   have IN_h: "d_IN h x = (if reachable x then d_IN g x else 0)" for x
   proof -
     have "d_IN h x = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. h (y, x))"
       using h_le_g currentD_outside[OF g] by(intro d_IN_alt_def) auto
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>\<^bold>I\<^bold>N x. if reachable x then g (y, x) else 0)"
       by(auto intro!: nn_integral_cong simp add: incoming_def dest: reachable_BA)
     also have "\<dots> = (if reachable x then d_IN g x else 0)"
       by(auto intro!: d_IN_alt_def[symmetric] currentD_outside[OF g])
     finally show ?thesis .
   qed
 
   have h: "current \<Gamma> h" using g h_le_g
   proof(rule current_leI)
     show "d_OUT h x \<le> d_IN h x" if "x \<notin> A \<Gamma>" for x
       by(simp add: OUT_h IN_h currentD_OUT_IN[OF g that])
   qed
 
   have reachable_full: "j (None, \<langle>y\<rangle>) = u y" if reach: "reachable y" for y
   proof(rule ccontr)
     assume "j (None, \<langle>y\<rangle>) \<noteq> u y"
     with flowD_capacity[OF j, of "(None, \<langle>y\<rangle>)"]
     have le: "j (None, \<langle>y\<rangle>) < u y" by(auto split: if_split_asm simp add: u_outside \<Psi>.flowD_outside[OF j] zero_less_iff_neq_zero)
     then obtain y: "y \<in> B \<Gamma>" and uy: "u y > 0" using u_outside[of y]
       by(cases "y \<in> B \<Gamma>"; cases "u y = 0") (auto simp add: zero_less_iff_neq_zero)
 
     from reach obtain q where q: "path G y q a" and distinct: "distinct (y # q)"
       unfolding reachable_alt_def by(auto elim: rtrancl_path_distinct)
     have q_Nil: "q \<noteq> []" using q a(1) disjoint y by(auto elim!: rtrancl_path.cases)
 
     let ?E = "zip (y # q) q"
     define E where "E = (None, Some y) # map (map_prod Some Some) ?E"
     define \<zeta> where "\<zeta> = Min (insert (u y - j (None, Some y)) (cap' ` set ?E))"
     let ?j' = "\<lambda>e. (if e \<in> set E then \<zeta> else 0) + j e"
     define j' where "j' = cleanup ?j'"
 
     have j_free: "0 < cap' e" if "e \<in> set ?E" for e using that unfolding E_def list.sel
     proof -
       from that obtain i where e: "e = ((y # q) ! i, q ! i)"
         and i: "i < length q" by(auto simp add: set_zip)
       have e': "edge G ((y # q) ! i) (q ! i)" using q i by(rule rtrancl_path_nth)
       thus ?thesis using e by(simp)
     qed
     have \<zeta>_pos: "0 < \<zeta>" unfolding \<zeta>_def using le
       by(auto intro: j_free diff_gr0_ennreal)
     have \<zeta>_le: "\<zeta> \<le> cap' e" if "e \<in> set ?E" for e using that unfolding \<zeta>_def by auto
     have finite_\<zeta> [simplified]: "\<zeta> < \<top>" unfolding \<zeta>_def
       by(intro Min_less_iff[THEN iffD2])(auto simp add: less_top[symmetric])
 
     have E_antiparallel: "(x', y') \<in> set ?E \<Longrightarrow> (y', x') \<notin> set ?E" for x' y'
       using distinct
       apply(auto simp add: in_set_zip nth_Cons in_set_conv_nth)
       apply(auto simp add: distinct_conv_nth split: nat.split_asm)
       by (metis Suc_lessD less_Suc_eq less_irrefl_nat)
 
     have OUT_j': "d_OUT ?j' x' = \<zeta> * card (set [(x'', y) \<leftarrow> E. x'' = x']) + d_OUT j x'" for x'
     proof -
       have "d_OUT ?j' x' = d_OUT (\<lambda>e. if e \<in> set E then \<zeta> else 0) x' + d_OUT j x'"
         using \<zeta>_pos by(intro d_OUT_add)
       also have "d_OUT (\<lambda>e. if e \<in> set E then \<zeta> else 0) x' = \<integral>\<^sup>+ y. \<zeta> * indicator (set E) (x', y) \<partial>count_space UNIV"
         unfolding d_OUT_def by(rule nn_integral_cong)(simp)
       also have "\<dots> = (\<integral>\<^sup>+ e. \<zeta> * indicator (set E) e \<partial>embed_measure (count_space UNIV) (Pair x'))"
         by(simp add: measurable_embed_measure1 nn_integral_embed_measure)
       also have "\<dots> = (\<integral>\<^sup>+ e. \<zeta> * indicator (set [(x'', y) \<leftarrow> E. x'' = x']) e \<partial>count_space UNIV)"
         by(auto simp add: embed_measure_count_space' nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator)
       also have "\<dots> = \<zeta> * card (set [(x'', y) \<leftarrow> E. x'' = x'])" using \<zeta>_pos by(simp add: nn_integral_cmult)
       finally show ?thesis .
     qed
     have IN_j': "d_IN ?j' x' = \<zeta> * card (set [(y, x'') \<leftarrow> E. x'' = x']) + d_IN j x'" for x'
     proof -
       have "d_IN ?j' x' = d_IN (\<lambda>e. if e \<in> set E then \<zeta> else 0) x' + d_IN j x'"
         using \<zeta>_pos by(intro d_IN_add)
       also have "d_IN (\<lambda>e. if e \<in> set E then \<zeta> else 0) x' = \<integral>\<^sup>+ y. \<zeta> * indicator (set E) (y, x') \<partial>count_space UNIV"
         unfolding d_IN_def by(rule nn_integral_cong)(simp)
       also have "\<dots> = (\<integral>\<^sup>+ e. \<zeta> * indicator (set E) e \<partial>embed_measure (count_space UNIV) (\<lambda>y. (y, x')))"
         by(simp add: measurable_embed_measure1 nn_integral_embed_measure)
       also have "\<dots> = (\<integral>\<^sup>+ e. \<zeta> * indicator (set [(y, x'') \<leftarrow> E. x'' = x']) e \<partial>count_space UNIV)"
         by(auto simp add: embed_measure_count_space' nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator)
       also have "\<dots> = \<zeta> * card (set [(y, x'') \<leftarrow> E. x'' = x'])"
         using \<zeta>_pos by(auto simp add: nn_integral_cmult)
       finally show ?thesis .
     qed
 
     have j': "flow \<Psi> j'"
     proof
       fix e :: "'v option edge"
       consider (None) "e = (None, Some y)"
         | (Some) x y where "e = (Some x, Some y)" "(x, y) \<in> set ?E"
         | (old) x y where "e = (Some x, Some y)" "(x, y) \<notin> set ?E"
         | y' where "e = (None, Some y')" "y \<noteq> y'"
         | "e = (None, None)" | x where "e = (Some x, None)"
         by(cases e; case_tac a; case_tac b)(auto)
       then show "j' e \<le> capacity \<Psi> e" using uy \<zeta>_pos flowD_capacity[OF j, of e]
       proof(cases)
         case None
         have "\<zeta> \<le> u y - j (None, Some y)" by(simp add: \<zeta>_def)
         then have "\<zeta> + j (None, Some y) \<le> u y"
           using \<zeta>_pos by (auto simp add: ennreal_le_minus_iff)
         thus ?thesis using reachable_V[OF reach] None \<Psi>.flowD_outside[OF j, of "(Some y, None)"] uy
           by(auto simp add: j'_def E_def)
       next
         case (Some x' y')
         have e: "\<zeta> \<le> cap' (x', y')" using Some(2) by(rule \<zeta>_le)
         then consider (backward) "edge \<Gamma> x' y'" "x' \<noteq> a" | (forward) "edge \<Gamma> y' x'" "\<not> edge \<Gamma> x' y'"
           | (a') "edge \<Gamma> x' y'" "x' = a"
           using Some \<zeta>_pos by(auto split: if_split_asm)
         then show ?thesis
         proof cases
           case backward
           have "\<zeta> \<le> f (x', y') + j (Some y', Some x') - j (Some x', Some y')"
             using e backward Some(1) by(simp add: g_simps)
           hence "\<zeta> + j (Some x', Some y') - j (Some y', Some x') \<le> (f (x', y') + j (Some y', Some x') - j (Some x', Some y')) + j (Some x', Some y') - j (Some y', Some x')"
             by(intro ennreal_minus_mono add_right_mono) simp_all
           also have "\<dots> = f (x', y')"
             using j_le_f[OF \<open>edge \<Gamma> x' y'\<close>]
             by(simp_all add: add_increasing2 less_top diff_add_assoc2_ennreal)
           finally show ?thesis using Some backward
             by(auto simp add: j'_def E_def dest: in_set_tlD E_antiparallel)
         next
           case forward
           have "\<zeta> + j (Some x', Some y') - j (Some y', Some x') \<le> \<zeta> + j (Some x', Some y')"
             by(rule diff_le_self_ennreal)
           also have "j (Some x', Some y') \<le> d_IN j (Some y')"
             by(rule d_IN_ge_point)
           also have "\<dots> \<le> weight \<Gamma> y'" by(rule IN_j_le_weight)
           also have "\<zeta> \<le> 1" using e forward by simp
           finally have "\<zeta> + j (Some x', Some y') - j (Some y', Some x') \<le> max (weight \<Gamma> x') (weight \<Gamma> y') + 1"
             by(simp add: add_left_mono add_right_mono max_def)(metis (no_types, lifting) add.commute add_right_mono less_imp_le less_le_trans not_le)
           then show ?thesis using Some forward e
             by(auto simp add: j'_def E_def max_def dest: in_set_tlD E_antiparallel)
         next
           case a'
           with Some have "a \<in> set (map fst (zip (y # q) q))" by(auto intro: rev_image_eqI)
           also have "map fst (zip (y # q) q) = butlast (y # q)" by(induction q arbitrary: y) auto
           finally have False using rtrancl_path_last[OF q q_Nil] distinct q_Nil
             by(cases q rule: rev_cases) auto
           then show ?thesis ..
         qed
       next
         case (old x' y')
         hence "j' e \<le> j e" using \<zeta>_pos
           by(auto simp add: j'_def E_def intro!: diff_le_self_ennreal)
         also have "j e \<le> capacity \<Psi> e" using j by(rule flowD_capacity)
         finally show ?thesis .
       qed(auto simp add: j'_def E_def \<Psi>.flowD_outside[OF j] uy)
     next
       fix x'
       assume x': "x' \<noteq> source \<Psi>" "x' \<noteq> sink \<Psi>"
       then obtain x'' where x'': "x' = Some x''" by auto
       have "d_OUT ?j' x' = \<zeta> * card (set [(x'', y) \<leftarrow> E. x'' = x']) + d_OUT j x'" by(rule OUT_j')
       also have "card (set [(x'', y) \<leftarrow> E. x'' = x']) = card (set [(y, x'') \<leftarrow> E. x'' = x'])" (is "?lhs = ?rhs")
       proof -
         have "?lhs = length [(x'', y) \<leftarrow> E. x'' = x']" using distinct
           by(subst distinct_card)(auto simp add: E_def filter_map distinct_map inj_map_prod' distinct_zipI1)
         also have "\<dots> = length [x''' \<leftarrow> map fst ?E. x''' = x'']"
           by(simp add: E_def x'' split_beta cong: filter_cong)
         also have "map fst ?E = butlast (y # q)" by(induction q arbitrary: y) simp_all
         also have "[x''' \<leftarrow> butlast (y # q). x''' = x''] = [x''' \<leftarrow> y # q. x''' = x'']"
           using q_Nil rtrancl_path_last[OF q q_Nil] x' x''
           by(cases q rule: rev_cases) simp_all
         also have "q = map snd ?E" by(induction q arbitrary: y) auto
         also have "length [x''' \<leftarrow> y # \<dots>. x''' = x''] = length [x'' \<leftarrow> map snd E. x'' = x']" using x''
           by(simp add: E_def cong: filter_cong)
         also have "\<dots> = length [(y, x'') \<leftarrow> E. x'' = x']" by(simp cong: filter_cong add: split_beta)
         also have "\<dots> = ?rhs" using distinct
           by(subst distinct_card)(auto simp add: E_def filter_map distinct_map inj_map_prod' distinct_zipI1)
         finally show ?thesis .
       qed
       also have "\<zeta> * \<dots> + d_OUT j x' =  d_IN ?j' x'"
         unfolding flowD_KIR[OF j x'] by(rule IN_j'[symmetric])
       also have "d_IN ?j' x' \<noteq> \<top>"
         using \<Psi>.flowD_finite_IN[OF j x'(2)] finite_\<zeta> IN_j'[of x'] by (auto simp: top_add ennreal_mult_eq_top_iff)
       ultimately show "KIR j' x'" unfolding j'_def by(rule KIR_cleanup)
     qed
     hence "value_flow \<Psi> j' \<le> \<alpha>" unfolding \<alpha>_def by(auto intro: SUP_upper)
     moreover have "value_flow \<Psi> j' > value_flow \<Psi> j"
     proof -
       have "value_flow \<Psi> j + 0 < value_flow \<Psi> j + \<zeta> * 1"
         using \<zeta>_pos value_j finite_flow by simp
       also have "[(x', y') \<leftarrow> E. x' = None] = [(None, Some y)]"
         using q_Nil by(cases q)(auto simp add: E_def filter_map cong: filter_cong split_beta)
       hence "\<zeta> * 1 \<le> \<zeta> * card (set [(x', y') \<leftarrow> E. x' = None])" using \<zeta>_pos
         by(intro mult_left_mono)(auto simp add: E_def real_of_nat_ge_one_iff neq_Nil_conv card.insert_remove)
       also have "value_flow \<Psi> j + \<dots> = value_flow \<Psi> ?j'"
         using OUT_j' by(simp add: add.commute)
       also have "\<dots> = value_flow \<Psi> j'" unfolding j'_def
         by(subst value_flow_cleanup)(auto simp add: E_def \<Psi>.flowD_outside[OF j])
       finally show ?thesis by(simp add: add_left_mono)
     qed
     ultimately show False using finite_flow \<zeta>_pos value_j
       by(cases "value_flow \<Psi> j" \<zeta> rule: ennreal2_cases) simp_all
   qed
 
   have sep_h: "y \<in> TER h" if reach: "reachable y" and y: "y \<in> B \<Gamma>" and TER: "y \<in> ?TER f" for y
   proof(rule ccontr)
     assume y': "y \<notin> TER h"
     from y a(1) disjoint have yna: "y \<noteq> a" by auto
 
     from reach obtain p' where "path G y p' a" unfolding reachable_alt_def ..
     then obtain p' where p': "path G y p' a" and distinct: "distinct (y # p')" by(rule rtrancl_path_distinct)
 
     have SINK: "y \<in> SINK h" using y disjoint
       by(auto simp add: SINK.simps d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0 intro: currentD_outside[OF g] dest: bipartite_E)
     have hg: "d_IN h y = d_IN g y" using reach by(simp add: IN_h)
     also have "\<dots> = d_IN f y + j (None, Some y)" by(simp add: IN_g)
     also have "d_IN f y = weight \<Gamma> y - u y" using currentD_weight_IN[OF f, of y] y disjoint TER
       by(auto elim!: SAT.cases)
     also have "d_IN h y < weight \<Gamma> y" using y' currentD_weight_IN[OF g, of y] y disjoint SINK
       by(auto intro: SAT.intros)
     ultimately have le: "j (None, Some y) < u y"
       by(cases "weight \<Gamma> y" "u y" "j (None, Some y)" rule: ennreal3_cases; cases "u y \<le> weight \<Gamma> y")
         (auto simp: ennreal_minus ennreal_plus[symmetric] add_top ennreal_less_iff ennreal_neg simp del: ennreal_plus)
     moreover from reach have "j (None, \<langle>y\<rangle>) = u y" by(rule reachable_full)
     ultimately show False by simp
   qed
 
   have w': "wave \<Gamma> h"
   proof
     show sep: "separating \<Gamma> (TER h)"
     proof(rule ccontr)
       assume "\<not> ?thesis"
       then obtain x p y where x: "x \<in> A \<Gamma>" and y: "y \<in> B \<Gamma>" and p: "path \<Gamma> x p y"
         and x': "x \<notin> TER h" and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER h"
         by(auto simp add: separating_gen.simps)
       from p disjoint x y have p_eq: "p = [y]" and edge: "(x, y) \<in> \<^bold>E"
         by -(erule rtrancl_path.cases, auto dest: bipartite_E)+
       from p_eq bypass have y': "y \<notin> TER h" by simp
       have "reachable x" using x' by(rule contrapos_np)(simp add: SINK.simps d_OUT_def SAT.A x)
       hence reach: "reachable y" using edge by(rule reachable_AB)
 
       have *: "x \<notin> \<E>\<^bsub>?\<Gamma>\<^esub> (?TER f)" using x'
       proof(rule contrapos_nn)
         assume *: "x \<in> \<E>\<^bsub>?\<Gamma>\<^esub> (?TER f)"
         have "d_OUT h x \<le> d_OUT g x" using h_le_g by(rule d_OUT_mono)
         also from * have "x \<noteq> a" using a by auto
         then have "d_OUT j (Some x) = d_IN j (Some x)" by(auto intro: flowD_KIR[OF j])
         hence "d_OUT g x \<le> d_OUT f x" using OUT_g_A[OF x] IN_j[of "Some x"] finite_flow
           by(auto split: if_split_asm)
         also have "\<dots> = 0" using * by(auto elim: SINK.cases)
         finally have "x \<in> SINK h" by(simp add: SINK.simps)
         with x show "x \<in> TER h" by(simp add: SAT.A)
       qed
       from p p_eq x y have "path ?\<Gamma> x [y] y" "x \<in> A ?\<Gamma>" "y \<in> B ?\<Gamma>" by simp_all
       from * separatingD[OF separating_essential, OF waveD_separating, OF w this]
       have "y \<in> ?TER f" by auto
       with reach y have "y \<in> TER h" by(rule sep_h)
       with y' show False by contradiction
     qed
   qed(rule h)
 
   have OUT_g_a: "d_OUT g a = d_OUT h a" by(simp add: OUT_h)
   have "a \<notin> \<E> (TER h)"
   proof
     assume *: "a \<in> \<E> (TER h)"
 
     have "j (Some a, Some y) = 0" for y
       using flowD_capacity[OF j, of "(Some a, Some y)"] a(1) disjoint
       by(auto split: if_split_asm dest: bipartite_E)
     then have "d_OUT f a \<le> d_OUT g a" unfolding d_OUT_def
       \<comment> \<open>This step requires that @{term j} does not decrease the outflow of @{term a}. That's
           why we set the capacity of the outgoing edges from @{term "Some a"} in @{term \<Psi>} to @{term "0 :: ennreal"}\<close>
       by(intro nn_integral_mono)(auto simp add: g_simps currentD_outside[OF f] intro: )
     then have "a \<in> SINK f" using OUT_g_a * by(simp add: SINK.simps)
     with a(1) have "a \<in> ?TER f" by(auto intro: SAT.A)
     with a(2) have a': "\<not> essential \<Gamma> (B \<Gamma>) (?TER f) a" by simp
 
     from * obtain y where ay: "edge \<Gamma> a y" and y: "y \<in> B \<Gamma>" and y': "y \<notin> TER h" using disjoint a(1)
       by(auto 4 4 simp add: essential_def elim: rtrancl_path.cases dest: bipartite_E)
     from not_essentialD[OF a' rtrancl_path.step, OF ay rtrancl_path.base y]
     have TER: "y \<in> ?TER f" by simp
 
     have "reachable y" using \<open>reachable a\<close> by(rule reachable_AB)(simp add: ay)
     hence "y \<in> TER h" using y TER by(rule sep_h)
     with y' show False by contradiction
   qed
   with \<open>a \<in> A \<Gamma>\<close> have "hindrance \<Gamma> h"
   proof
     have "d_OUT h a = d_OUT g a" by(simp add: OUT_g_a)
     also have "\<dots> \<le> d_OUT f a + \<integral>\<^sup>+ y. j (Some y, Some a) \<partial>count_space UNIV"
       unfolding d_OUT_def d_IN_def
       by(subst nn_integral_add[symmetric])(auto simp add: g_simps intro!: nn_integral_mono diff_le_self_ennreal)
     also have "(\<integral>\<^sup>+ y. j (Some y, Some a) \<partial>count_space UNIV) = (\<integral>\<^sup>+ y. j (y, Some a) \<partial>embed_measure (count_space UNIV) Some)"
       by(simp add: nn_integral_embed_measure measurable_embed_measure1)
     also have "\<dots> \<le> d_IN j (Some a)" unfolding d_IN_def
       by(auto simp add: embed_measure_count_space nn_integral_count_space_indicator intro!: nn_integral_mono split: split_indicator)
     also have "\<dots> \<le> \<alpha>" by(rule IN_j)
     also have "\<dots> \<le> \<epsilon>" by(rule \<alpha>_le)
     also have "d_OUT f a + \<dots> < d_OUT f a + (weight \<Gamma> a - d_OUT f a)" using \<epsilon>_less
       using currentD_finite_OUT[OF f'] by (simp add: ennreal_add_left_cancel_less)
     also have "\<dots> = weight \<Gamma> a"
       using a_le by simp
     finally show "d_OUT h a < weight \<Gamma> a" by(simp add: add_left_mono)
   qed
   then show ?thesis using h w' by(blast intro: hindered.intros)
 qed
 
 end
 
 corollary hindered_reduce_current: \<comment> \<open>Corollary 6.8\<close>
   fixes \<epsilon> g
   defines "\<epsilon> \<equiv> \<Sum>\<^sup>+ x\<in>B \<Gamma>. d_IN g x - d_OUT g x"
   assumes g: "current \<Gamma> g"
   and \<epsilon>_finite: "\<epsilon> \<noteq> \<top>"
   and hindered: "hindered_by (\<Gamma> \<ominus> g) \<epsilon>"
   shows "hindered \<Gamma>"
 proof -
   define \<Gamma>' where "\<Gamma>' = \<Gamma>\<lparr>weight := \<lambda>x. if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT g x else weight \<Gamma> x\<rparr>"
   have \<Gamma>'_sel [simp]:
     "edge \<Gamma>' = edge \<Gamma>"
     "A \<Gamma>' = A \<Gamma>"
     "B \<Gamma>' = B \<Gamma>"
     "weight \<Gamma>' x = (if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT g x else weight \<Gamma> x)"
     "vertex \<Gamma>' = vertex \<Gamma>"
     "web.more \<Gamma>' = web.more \<Gamma>"
     for x by(simp_all add: \<Gamma>'_def)
   have "countable_bipartite_web \<Gamma>'"
     by unfold_locales(simp_all add: A_in B_out A_vertex disjoint bipartite_V no_loop weight_outside currentD_outside_OUT[OF g]  currentD_weight_OUT[OF g] edge_antiparallel, rule bipartite_E)
   then interpret \<Gamma>': countable_bipartite_web \<Gamma>' .
   let ?u = "\<lambda>x. (d_IN g x - d_OUT g x) * indicator (- A \<Gamma>) x"
 
   have "hindered \<Gamma>'"
   proof(rule \<Gamma>'.hindered_reduce)
     show "?u x = 0" if "x \<notin> B \<Gamma>'" for x using that bipartite_V
       by(cases "vertex \<Gamma>' x")(auto simp add: currentD_outside_OUT[OF g] currentD_outside_IN[OF g])
 
     have *: "(\<Sum>\<^sup>+ x\<in>B \<Gamma>'. ?u x) = \<epsilon>" using disjoint
       by(auto intro!: nn_integral_cong simp add: \<epsilon>_def nn_integral_count_space_indicator currentD_outside_OUT[OF g] currentD_outside_IN[OF g] not_vertex split: split_indicator)
     thus "(\<Sum>\<^sup>+ x\<in>B \<Gamma>'. ?u x) \<noteq> \<top>" using \<epsilon>_finite by simp
 
     have **: "\<Gamma>'\<lparr>weight := weight \<Gamma>' - ?u\<rparr> = \<Gamma> \<ominus> g"
       using currentD_weight_IN[OF g] currentD_OUT_IN[OF g] currentD_IN[OF g] currentD_finite_OUT[OF g]
       by(intro web.equality)(simp_all add: fun_eq_iff diff_diff_ennreal' ennreal_diff_le_mono_left)
     show "hindered_by (\<Gamma>'\<lparr>weight := weight \<Gamma>' - ?u\<rparr>) (\<Sum>\<^sup>+ x\<in>B \<Gamma>'. ?u x)"
       unfolding * ** by(fact hindered)
     show "(\<lambda>x. (d_IN g x - d_OUT g x) * indicator (- A \<Gamma>) x) \<le> weight \<Gamma>'"
       using currentD_weight_IN[OF g]
       by (simp add: le_fun_def ennreal_diff_le_mono_left)
   qed
   then show ?thesis
     by(rule hindered_mono_web[rotated -1]) simp_all
 qed
 
 end
 
 subsection \<open>Reduced weight in a loose web\<close>
 
 definition reduce_weight :: "('v, 'more) web_scheme \<Rightarrow> 'v \<Rightarrow> real \<Rightarrow> ('v, 'more) web_scheme"
 where "reduce_weight \<Gamma> x r = \<Gamma>\<lparr>weight := \<lambda>y. weight \<Gamma> y - (if x = y then r else 0)\<rparr>"
 
 lemma reduce_weight_sel [simp]:
   "edge (reduce_weight \<Gamma> x r) = edge \<Gamma>"
   "A (reduce_weight \<Gamma> x r) = A \<Gamma>"
   "B (reduce_weight \<Gamma> x r) = B \<Gamma>"
   "vertex (reduce_weight \<Gamma> x r) = vertex \<Gamma>"
   "weight (reduce_weight \<Gamma> x r) y = (if x = y then weight \<Gamma> x - r else weight \<Gamma> y)"
   "web.more (reduce_weight \<Gamma> x r) = web.more \<Gamma>"
 by(simp_all add: reduce_weight_def zero_ennreal_def[symmetric] vertex_def fun_eq_iff)
 
 lemma essential_reduce_weight [simp]: "essential (reduce_weight \<Gamma> x r) = essential \<Gamma>"
 by(simp add: fun_eq_iff essential_def)
 
 lemma roofed_reduce_weight [simp]: "roofed_gen (reduce_weight \<Gamma> x r) = roofed_gen \<Gamma>"
 by(simp add: fun_eq_iff roofed_def)
 
 context countable_bipartite_web begin
 
 context begin
 private datatype (plugins del: transfer size) 'a vertex = SOURCE | SINK | Inner (inner: 'a)
 
 private lemma notin_range_Inner:  "x \<notin> range Inner \<longleftrightarrow> x = SOURCE \<or> x = SINK"
 by(cases x) auto
 
 private lemma inj_Inner [simp]: "\<And>A. inj_on Inner A"
 by(simp add: inj_on_def)
 
 lemma unhinder_bipartite:
   assumes h: "\<And>n :: nat. current \<Gamma> (h n)"
   and SAT: "\<And>n. (B \<Gamma> \<inter> \<^bold>V) - {b} \<subseteq> SAT \<Gamma> (h n)"
   and b: "b \<in> B \<Gamma>"
   and IN: "(SUP n. d_IN (h n) b) = weight \<Gamma> b"
   and h0_b: "\<And>n. d_IN (h 0) b \<le> d_IN (h n) b"
   and b_V: "b \<in> \<^bold>V"
   shows "\<exists>h'. current \<Gamma> h' \<and> wave \<Gamma> h' \<and> B \<Gamma> \<inter> \<^bold>V \<subseteq> SAT \<Gamma> h'"
 proof -
   write Inner ("\<langle>_\<rangle>")
   define edge'
     where "edge' xo yo =
       (case (xo, yo) of
         (\<langle>x\<rangle>, \<langle>y\<rangle>) \<Rightarrow> edge \<Gamma> x y \<or> edge \<Gamma> y x
       | (\<langle>x\<rangle>, SINK) \<Rightarrow> x \<in> A \<Gamma>
       | (SOURCE, \<langle>y\<rangle>) \<Rightarrow> y = b
       | (SINK, \<langle>x\<rangle>) \<Rightarrow> x \<in> A \<Gamma>
       | _ \<Rightarrow> False)" for xo yo
   have edge'_simps [simp]:
     "edge' \<langle>x\<rangle> \<langle>y\<rangle> \<longleftrightarrow> edge \<Gamma> x y \<or> edge \<Gamma> y x"
     "edge' \<langle>x\<rangle> SINK \<longleftrightarrow> x \<in> A \<Gamma>"
     "edge' SOURCE yo \<longleftrightarrow> yo = \<langle>b\<rangle>"
     "edge' SINK \<langle>x\<rangle> \<longleftrightarrow> x \<in> A \<Gamma>"
     "edge' SINK SINK \<longleftrightarrow> False"
     "edge' xo SOURCE \<longleftrightarrow> False"
     for x y yo xo by(simp_all add: edge'_def split: vertex.split)
   have edge'E: "thesis" if "edge' xo yo"
     "\<And>x y. \<lbrakk> xo = \<langle>x\<rangle>; yo = \<langle>y\<rangle>; edge \<Gamma> x y \<or> edge \<Gamma> y x \<rbrakk> \<Longrightarrow> thesis"
     "\<And>x. \<lbrakk> xo = \<langle>x\<rangle>; yo = SINK; x \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     "\<And>x. \<lbrakk> xo = SOURCE; yo = \<langle>b\<rangle> \<rbrakk> \<Longrightarrow> thesis"
     "\<And>y. \<lbrakk> xo = SINK; yo = \<langle>y\<rangle>; y \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     for xo yo thesis using that by(auto simp add: edge'_def split: option.split_asm vertex.split_asm)
   have edge'_Inner1 [elim!]: "thesis" if "edge' \<langle>x\<rangle> yo"
     "\<And>y. \<lbrakk> yo = \<langle>y\<rangle>; edge \<Gamma> x y \<or> edge \<Gamma> y x \<rbrakk> \<Longrightarrow> thesis"
     "\<lbrakk> yo = SINK; x \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     for x yo thesis using that by(auto elim: edge'E)
   have edge'_Inner2 [elim!]: "thesis" if "edge' xo \<langle>y\<rangle>"
     "\<And>x. \<lbrakk> xo = \<langle>x\<rangle>; edge \<Gamma> x y \<or> edge \<Gamma> y x \<rbrakk> \<Longrightarrow> thesis"
     "\<lbrakk> xo = SOURCE; y = b \<rbrakk> \<Longrightarrow> thesis"
     "\<lbrakk> xo = SINK; y \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     for xo y thesis using that by(auto elim: edge'E)
   have edge'_SINK1 [elim!]: "thesis" if "edge' SINK yo"
     "\<And>y. \<lbrakk> yo = \<langle>y\<rangle>; y \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     for yo thesis using that by(auto elim: edge'E)
   have edge'_SINK2 [elim!]: "thesis" if "edge' xo SINK"
     "\<And>x. \<lbrakk> xo = \<langle>x\<rangle>; x \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> thesis"
     for xo thesis using that by(auto elim: edge'E)
 
   define cap
     where "cap xoyo =
       (case xoyo of
         (\<langle>x\<rangle>, \<langle>y\<rangle>) \<Rightarrow> if edge \<Gamma> x y then h 0 (x, y) else if edge \<Gamma> y x then max (weight \<Gamma> x) (weight \<Gamma> y) else 0
       | (\<langle>x\<rangle>, SINK) \<Rightarrow> if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT (h 0) x else 0
       | (SOURCE, yo) \<Rightarrow> if yo = \<langle>b\<rangle> then weight \<Gamma> b - d_IN (h 0) b else 0
       | (SINK, \<langle>y\<rangle>) \<Rightarrow> if y \<in> A \<Gamma> then weight \<Gamma> y else 0
       | _ \<Rightarrow> 0)" for xoyo
   have cap_simps [simp]:
     "cap (\<langle>x\<rangle>, \<langle>y\<rangle>) = (if edge \<Gamma> x y then h 0 (x, y) else if edge \<Gamma> y x then max (weight \<Gamma> x) (weight \<Gamma> y) else 0)"
     "cap (\<langle>x\<rangle>, SINK) = (if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT (h 0) x else 0)"
     "cap (SOURCE, yo) = (if yo = \<langle>b\<rangle> then weight \<Gamma> b - d_IN (h 0) b else 0)"
     "cap (SINK, \<langle>y\<rangle>) = (if y \<in> A \<Gamma> then weight \<Gamma> y else 0)"
     "cap (SINK, SINK) = 0"
     "cap (xo, SOURCE) = 0"
     for x y yo xo by(simp_all add: cap_def split: vertex.split)
   define \<Psi> where "\<Psi> = \<lparr>edge = edge', capacity = cap, source = SOURCE, sink = SINK\<rparr>"
   have \<Psi>_sel [simp]:
     "edge \<Psi> = edge'"
     "capacity \<Psi> = cap"
     "source \<Psi> = SOURCE"
     "sink \<Psi> = SINK"
     by(simp_all add: \<Psi>_def)
 
   have cap_outside1: "\<not> vertex \<Gamma> x \<Longrightarrow> cap (\<langle>x\<rangle>, y) = 0" for x y using A_vertex
     by(cases y)(auto simp add: vertex_def)
   have capacity_A_weight: "d_OUT cap \<langle>x\<rangle> \<le> 2 * weight \<Gamma> x" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_OUT cap \<langle>x\<rangle> \<le> (\<Sum>\<^sup>+ y. h 0 (x, inner y) * indicator (range Inner) y + weight \<Gamma> x * indicator {SINK} y)"
       using that disjoint unfolding d_OUT_def
       by(auto intro!: nn_integral_mono diff_le_self_ennreal simp add: A_in notin_range_Inner  split: split_indicator)
     also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. h 0 (x, inner y)) + weight \<Gamma> x"
       by(auto simp add: nn_integral_count_space_indicator nn_integral_add)
     also have "(\<Sum>\<^sup>+ y\<in>range Inner. h 0 (x, inner y)) = d_OUT (h 0) x"
       by(simp add: d_OUT_def nn_integral_count_space_reindex)
     also have "\<dots> \<le> weight \<Gamma> x" using h by(rule currentD_weight_OUT)
     finally show ?thesis unfolding one_add_one[symmetric] distrib_right by(simp add: add_right_mono)
   qed
   have flow_attainability: "flow_attainability \<Psi>"
   proof
     have "\<^bold>E\<^bsub>\<Psi>\<^esub> \<subseteq> (\<lambda>(x, y). (\<langle>x\<rangle>, \<langle>y\<rangle>)) ` \<^bold>E \<union> (\<lambda>(x, y). (\<langle>y\<rangle>, \<langle>x\<rangle>)) ` \<^bold>E \<union> (\<lambda>x. (\<langle>x\<rangle>, SINK)) ` A \<Gamma> \<union> (\<lambda>x. (SINK, \<langle>x\<rangle>)) ` A \<Gamma> \<union> {(SOURCE, \<langle>b\<rangle>)}"
       by(auto simp add: edge'_def split: vertex.split_asm)
     moreover have "countable (A \<Gamma>)" using A_vertex by(rule countable_subset) simp
     ultimately show "countable \<^bold>E\<^bsub>\<Psi>\<^esub>" by(auto elim: countable_subset)
   next
     fix v
     assume "v \<noteq> sink \<Psi>"
     then consider (source) "v = SOURCE" | (A) x where "v = \<langle>x\<rangle>" "x \<in> A \<Gamma>"
       | (B) y where "v = \<langle>y\<rangle>" "y \<notin> A \<Gamma>" "y \<in> \<^bold>V" | (outside) x where "v = \<langle>x\<rangle>" "x \<notin> \<^bold>V"
       by(cases v) auto
     then show "d_IN (capacity \<Psi>) v \<noteq> \<top> \<or> d_OUT (capacity \<Psi>) v \<noteq> \<top>"
     proof cases
       case source thus ?thesis by(simp add: d_IN_def)
     next
       case (A x)
       thus ?thesis using capacity_A_weight[of x] by (auto simp: top_unique ennreal_mult_eq_top_iff)
     next
       case (B y)
       have "d_IN (capacity \<Psi>) v \<le> (\<Sum>\<^sup>+ x. h 0 (inner x, y) * indicator (range Inner) x + weight \<Gamma> b * indicator {SOURCE} x)"
         using B bipartite_V
         by(auto 4 4 intro!: nn_integral_mono simp add: diff_le_self_ennreal   d_IN_def notin_range_Inner nn_integral_count_space_indicator currentD_outside[OF h] split: split_indicator dest: bipartite_E)
       also have "\<dots> = (\<Sum>\<^sup>+ x\<in>range Inner. h 0 (inner x, y)) + weight \<Gamma> b"
         by(simp add: nn_integral_add nn_integral_count_space_indicator)
       also have "(\<Sum>\<^sup>+ x\<in>range Inner. h 0 (inner x, y)) = d_IN (h 0) y"
         by(simp add: d_IN_def nn_integral_count_space_reindex)
       also have "d_IN (h 0) y \<le> weight \<Gamma> y" using h by(rule currentD_weight_IN)
       finally show ?thesis by(auto simp add: top_unique add_right_mono split: if_split_asm)
     next
       case outside
       hence "d_OUT (capacity \<Psi>) v = 0" using A_vertex
         by(auto simp add: d_OUT_def nn_integral_0_iff_AE AE_count_space cap_def vertex_def split: vertex.split)
       thus ?thesis by simp
     qed
   next
     show "capacity \<Psi> e \<noteq> \<top>" for e
       by(auto simp add: cap_def max_def vertex_def currentD_finite[OF h] split: vertex.split prod.split)
     show "capacity \<Psi> e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Psi>\<^esub>" for e using that
       by(auto simp add: cap_def max_def split: prod.split; split vertex.split)+
     show "\<not> edge \<Psi> x (source \<Psi>)" for x using b by(auto simp add: B_out)
     show "\<not> edge \<Psi> x x" for x by(cases x)(simp_all add: no_loop)
     show "source \<Psi> \<noteq> sink \<Psi>" by simp
   qed
   then interpret \<Psi>: flow_attainability "\<Psi>" .
   define \<alpha> where "\<alpha> = (SUP f\<in>{f. flow \<Psi> f}. value_flow \<Psi> f)"
 
   define f
     where "f n xoyo =
     (case xoyo of
       (\<langle>x\<rangle>, \<langle>y\<rangle>) \<Rightarrow> if edge \<Gamma> x y then h 0 (x, y) - h n (x, y) else if edge \<Gamma> y x then h n (y, x) - h 0 (y, x) else 0
     | (SOURCE, \<langle>y\<rangle>) \<Rightarrow> if y = b then d_IN (h n) b - d_IN (h 0) b else 0
     | (\<langle>x\<rangle>, SINK) \<Rightarrow> if x \<in> A \<Gamma> then d_OUT (h n) x - d_OUT (h 0) x else 0
     | (SINK, \<langle>y\<rangle>) \<Rightarrow> if y \<in> A \<Gamma> then d_OUT (h 0) y - d_OUT (h n) y else 0
     | _ \<Rightarrow> 0)" for n xoyo
   have f_cases: thesis if "\<And>x y. e = (\<langle>x\<rangle>, \<langle>y\<rangle>) \<Longrightarrow> thesis" "\<And>y. e = (SOURCE, \<langle>y\<rangle>) \<Longrightarrow> thesis"
     "\<And>x. e = (\<langle>x\<rangle>, SINK) \<Longrightarrow> thesis" "\<And>y. e = (SINK, \<langle>y\<rangle>) \<Longrightarrow> thesis" "e = (SINK, SINK) \<Longrightarrow> thesis"
     "\<And>xo. e = (xo, SOURCE) \<Longrightarrow> thesis" "e = (SOURCE, SINK) \<Longrightarrow> thesis"
     for e :: "'v vertex edge" and thesis
     using that by(cases e; cases "fst e" "snd e" rule: vertex.exhaust[case_product vertex.exhaust]) simp_all
   have f_simps [simp]:
     "f n (\<langle>x\<rangle>, \<langle>y\<rangle>) = (if edge \<Gamma> x y then h 0 (x, y) - h n (x, y) else if edge \<Gamma> y x then h n (y, x) - h 0 (y, x) else 0)"
     "f n (SOURCE, \<langle>y\<rangle>) = (if y = b then d_IN (h n) b - d_IN (h 0) b else 0)"
     "f n (\<langle>x\<rangle>, SINK) = (if x \<in> A \<Gamma> then d_OUT (h n) x - d_OUT (h 0) x else 0)"
     "f n (SINK, \<langle>y\<rangle>) = (if y \<in> A \<Gamma> then d_OUT (h 0) y - d_OUT (h n) y else 0)"
     "f n (SOURCE, SINK) = 0"
     "f n (SINK, SINK) = 0"
     "f n (xo, SOURCE) = 0"
     for n x y xo by(simp_all add: f_def split: vertex.split)
   have OUT_f_SOURCE: "d_OUT (f n) SOURCE = d_IN (h n) b - d_IN (h 0) b" for n
   proof(rule trans)
     show "d_OUT (f n) SOURCE = (\<Sum>\<^sup>+ y. f n (SOURCE, y) * indicator {\<langle>b\<rangle>} y)" unfolding d_OUT_def
       apply(rule nn_integral_cong) subgoal for x by(cases x) auto done
     show "\<dots> = d_IN (h n) b - d_IN (h 0) b" using h0_b[of n]
       by(auto simp add: max_def)
   qed
 
   have OUT_f_outside: "d_OUT (f n) \<langle>x\<rangle> = 0" if "x \<notin> \<^bold>V" for x n using A_vertex that
     apply(clarsimp simp add: d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0)
     subgoal for y by(cases y)(auto simp add: vertex_def)
     done
   have IN_f_outside: "d_IN (f n) \<langle>x\<rangle> = 0" if "x \<notin> \<^bold>V" for x n using b_V that
     apply(clarsimp simp add: d_IN_def nn_integral_0_iff emeasure_count_space_eq_0)
     subgoal for y by(cases y)(auto simp add: currentD_outside_OUT[OF h] vertex_def)
     done
 
   have f: "flow \<Psi> (f n)" for n
   proof
     show f_le: "f n e \<le> capacity \<Psi> e" for e
       using currentD_weight_out[OF h] currentD_weight_IN[OF h] currentD_weight_OUT[OF h]
       by(cases e rule: f_cases)
         (auto dest: edge_antiparallel simp add: not_le le_max_iff_disj intro: ennreal_minus_mono ennreal_diff_le_mono_left)
 
     fix xo
     assume "xo \<noteq> source \<Psi>" "xo \<noteq> sink \<Psi>"
     then consider (A) x where "xo = \<langle>x\<rangle>" "x \<in> A \<Gamma>" | (B) x where "xo = \<langle>x\<rangle>" "x \<in> B \<Gamma>" "x \<in> \<^bold>V"
       | (outside) x where "xo = \<langle>x\<rangle>" "x \<notin> \<^bold>V" using bipartite_V by(cases xo) auto
     then show "KIR (f n) xo"
     proof cases
       case outside
       thus ?thesis by(simp add: OUT_f_outside IN_f_outside)
     next
       case A
 
       have finite1: "(\<Sum>\<^sup>+ y. h n (x, y) * indicator A y) \<noteq> \<top>" for A n
         using currentD_finite_OUT[OF h, of n x, unfolded d_OUT_def]
         by(rule neq_top_trans)(auto intro!: nn_integral_mono simp add: split: split_indicator)
 
       let ?h0_ge_hn = "{y. h 0 (x, y) \<ge> h n (x, y)}"
       let ?h0_lt_hn = "{y. h 0 (x, y) < h n (x, y)}"
 
       have "d_OUT (f n) \<langle>x\<rangle> = (\<Sum>\<^sup>+ y. f n (\<langle>x\<rangle>, y) * indicator (range Inner) y + f n (\<langle>x\<rangle>, y) * indicator {SINK} y)"
         unfolding d_OUT_def by(intro nn_integral_cong)(auto split: split_indicator simp add: notin_range_Inner)
       also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. f n (\<langle>x\<rangle>, y)) + f n (\<langle>x\<rangle>, SINK)"
         by(simp add: nn_integral_add nn_integral_count_space_indicator max.left_commute max.commute)
       also have "(\<Sum>\<^sup>+ y\<in>range Inner. f n (\<langle>x\<rangle>, y)) = (\<Sum>\<^sup>+ y. h 0 (x, y) - h n (x, y))" using A
         apply(simp add: nn_integral_count_space_reindex cong: nn_integral_cong_simp outgoing_def)
         apply(auto simp add: nn_integral_count_space_indicator outgoing_def A_in max.absorb1 currentD_outside[OF h] intro!: nn_integral_cong split: split_indicator dest: edge_antiparallel)
         done
       also have "\<dots> = (\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_ge_hn y) - (\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_ge_hn y)"
         apply(subst nn_integral_diff[symmetric])
         apply(simp_all add: AE_count_space finite1 split: split_indicator)
         apply(rule nn_integral_cong; auto simp add: max_def not_le split: split_indicator)
         by (metis diff_eq_0_ennreal le_less not_le top_greatest)
       also have "(\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_ge_hn y) = d_OUT (h n) x - (\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_lt_hn y)"
         unfolding d_OUT_def
         apply(subst nn_integral_diff[symmetric])
         apply(auto simp add: AE_count_space finite1 currentD_finite[OF h] split: split_indicator intro!: nn_integral_cong)
         done
       also have "(\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_ge_hn y) - \<dots> + f n (\<langle>x\<rangle>, SINK) =
         (\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_ge_hn y) + (\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_lt_hn y) - min (d_OUT (h n) x) (d_OUT (h 0) x)"
         using finite1[of n "{_}"] A finite1[of n UNIV]
         apply (subst diff_diff_ennreal')
         apply (auto simp: d_OUT_def finite1 AE_count_space nn_integral_diff[symmetric] top_unique nn_integral_add[symmetric]
                     split: split_indicator intro!: nn_integral_mono ennreal_diff_self)
         apply (simp add: min_def not_le diff_eq_0_ennreal finite1 less_top[symmetric])
         apply (subst diff_add_assoc2_ennreal)
         apply (auto simp: add_diff_eq_ennreal intro!: nn_integral_mono split: split_indicator)
         apply (subst diff_diff_commute_ennreal)
         apply (simp add: ennreal_add_diff_cancel )
         done
       also have "\<dots> = (\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_lt_hn y) - (d_OUT (h 0) x - (\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_ge_hn y)) + f n (SINK, \<langle>x\<rangle>)"
         apply(rule sym)
         using finite1[of 0 "{_}"] A finite1[of 0 UNIV]
         apply (subst diff_diff_ennreal')
         apply (auto simp: d_OUT_def finite1 AE_count_space nn_integral_diff[symmetric] top_unique nn_integral_add[symmetric]
                     split: split_indicator intro!: nn_integral_mono ennreal_diff_self)
         apply (simp add: min_def not_le diff_eq_0_ennreal finite1 less_top[symmetric])
         apply (subst diff_add_assoc2_ennreal)
         apply (auto simp: add_diff_eq_ennreal intro!: nn_integral_mono split: split_indicator)
         apply (subst diff_diff_commute_ennreal)
         apply (simp_all add: ennreal_add_diff_cancel ac_simps)
         done
       also have "d_OUT (h 0) x - (\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_ge_hn y) = (\<Sum>\<^sup>+ y. h 0 (x, y) * indicator ?h0_lt_hn y)"
         unfolding d_OUT_def
         apply(subst nn_integral_diff[symmetric])
         apply(auto simp add: AE_count_space finite1 currentD_finite[OF h] split: split_indicator intro!: nn_integral_cong)
         done
       also have "(\<Sum>\<^sup>+ y. h n (x, y) * indicator ?h0_lt_hn y) - \<dots> = (\<Sum>\<^sup>+ y. h n (x, y) - h 0 (x, y))"
         apply(subst nn_integral_diff[symmetric])
         apply(simp_all add: AE_count_space finite1 order.strict_implies_order split: split_indicator)
         apply(rule nn_integral_cong; auto simp add: currentD_finite[OF h] top_unique less_top[symmetric] not_less split: split_indicator intro!: diff_eq_0_ennreal)
         done
       also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. f n (y, \<langle>x\<rangle>))" using A
         apply(simp add: nn_integral_count_space_reindex cong: nn_integral_cong_simp outgoing_def)
         apply(auto simp add: nn_integral_count_space_indicator outgoing_def A_in max.commute currentD_outside[OF h] intro!: nn_integral_cong split: split_indicator dest: edge_antiparallel)
         done
       also have "\<dots> + f n (SINK, \<langle>x\<rangle>) = (\<Sum>\<^sup>+ y. f n (y, \<langle>x\<rangle>) * indicator (range Inner) y + f n (y, \<langle>x\<rangle>) * indicator {SINK} y)"
         by(simp add: nn_integral_add nn_integral_count_space_indicator)
       also have "\<dots> = d_IN (f n) \<langle>x\<rangle>"
         using A b disjoint unfolding d_IN_def
         by(intro nn_integral_cong)(auto split: split_indicator simp add: notin_range_Inner)
       finally show ?thesis using A by simp
     next
       case (B x)
 
       have finite1: "(\<Sum>\<^sup>+ y. h n (y, x) * indicator A y) \<noteq> \<top>" for A n
         using currentD_finite_IN[OF h, of n x, unfolded d_IN_def]
         by(rule neq_top_trans)(auto intro!: nn_integral_mono split: split_indicator)
 
       have finite_h[simp]: "h n (y, x) < \<top>" for y n
         using finite1[of n "{y}"] by (simp add: less_top)
 
       let ?h0_gt_hn = "{y. h 0 (y, x) > h n (y, x)}"
       let ?h0_le_hn = "{y. h 0 (y, x) \<le> h n (y, x)}"
 
       have eq: "d_IN (h 0) x + f n (SOURCE, \<langle>x\<rangle>) = d_IN (h n) x"
       proof(cases "x = b")
         case True with currentD_finite_IN[OF h, of _ b] show ?thesis
           by(simp add: add_diff_self_ennreal h0_b)
       next
         case False
         with B SAT have "x \<in> SAT \<Gamma> (h n)" "x \<in> SAT \<Gamma> (h 0)" by auto
         with B disjoint have "d_IN (h n) x = d_IN (h 0) x" by(auto simp add: currentD_SAT[OF h])
         thus ?thesis using False by(simp add: currentD_finite_IN[OF h])
       qed
 
       have "d_IN (f n) \<langle>x\<rangle> = (\<Sum>\<^sup>+ y. f n (y, \<langle>x\<rangle>) * indicator (range Inner) y + f n (y, \<langle>x\<rangle>) * indicator {SOURCE} y)"
         using B disjoint unfolding d_IN_def
         by(intro nn_integral_cong)(auto split: split_indicator simp add: notin_range_Inner)
       also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. f n (y, \<langle>x\<rangle>)) + f n (SOURCE, \<langle>x\<rangle>)" using h0_b[of n]
         by(simp add: nn_integral_add nn_integral_count_space_indicator max_def)
       also have "(\<Sum>\<^sup>+ y\<in>range Inner. f n (y, \<langle>x\<rangle>)) = (\<Sum>\<^sup>+ y. h 0 (y, x) - h n (y, x))"
         using B disjoint
         apply(simp add: nn_integral_count_space_reindex cong: nn_integral_cong_simp outgoing_def)
         apply(auto simp add: nn_integral_count_space_indicator outgoing_def B_out max.commute currentD_outside[OF h] intro!: nn_integral_cong split: split_indicator dest: edge_antiparallel)
         done
       also have "\<dots> = (\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_gt_hn y) - (\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_gt_hn y)"
         apply(subst nn_integral_diff[symmetric])
         apply(simp_all add: AE_count_space finite1 order.strict_implies_order split: split_indicator)
         apply(rule nn_integral_cong; auto simp add: currentD_finite[OF h] top_unique less_top[symmetric] not_less split: split_indicator intro!: diff_eq_0_ennreal)
         done
       also have eq_h_0: "(\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_gt_hn y) = d_IN (h 0) x - (\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_le_hn y)"
         unfolding d_IN_def
         apply(subst nn_integral_diff[symmetric])
         apply(auto simp add: AE_count_space finite1 currentD_finite[OF h] split: split_indicator intro!: nn_integral_cong)
         done
       also have eq_h_n: "(\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_gt_hn y) = d_IN (h n) x - (\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_le_hn y)"
         unfolding d_IN_def
         apply(subst nn_integral_diff[symmetric])
         apply(auto simp add: AE_count_space finite1 currentD_finite[OF h] split: split_indicator intro!: nn_integral_cong)
         done
       also have "d_IN (h 0) x - (\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_le_hn y) - (d_IN (h n) x - (\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_le_hn y)) + f n (SOURCE, \<langle>x\<rangle>) =
                 (\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_le_hn y) - (\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_le_hn y)"
         apply (subst diff_add_assoc2_ennreal)
         subgoal by (auto simp add: eq_h_0[symmetric] eq_h_n[symmetric] split: split_indicator intro!: nn_integral_mono)
         apply (subst diff_add_assoc2_ennreal)
         subgoal by (auto simp: d_IN_def split: split_indicator intro!: nn_integral_mono)
         apply (subst diff_diff_commute_ennreal)
         apply (subst diff_diff_ennreal')
         subgoal
           by (auto simp: d_IN_def split: split_indicator intro!: nn_integral_mono) []
         subgoal
           unfolding eq_h_n[symmetric]
           by (rule add_increasing2)
              (auto simp add: d_IN_def split: split_indicator intro!: nn_integral_mono)
         apply (subst diff_add_assoc2_ennreal[symmetric])
         unfolding eq
         using currentD_finite_IN[OF h]
         apply simp_all
         done
       also have "(\<Sum>\<^sup>+ y. h n (y, x) * indicator ?h0_le_hn y) - (\<Sum>\<^sup>+ y. h 0 (y, x) * indicator ?h0_le_hn y) = (\<Sum>\<^sup>+ y. h n (y, x) - h 0 (y, x))"
         apply(subst nn_integral_diff[symmetric])
         apply(simp_all add: AE_count_space max_def finite1 split: split_indicator)
         apply(rule nn_integral_cong; auto simp add: not_le split: split_indicator)
         by (metis diff_eq_0_ennreal le_less not_le top_greatest)
       also have "\<dots> = (\<Sum>\<^sup>+ y\<in>range Inner. f n (\<langle>x\<rangle>, y))" using B disjoint
         apply(simp add: nn_integral_count_space_reindex cong: nn_integral_cong_simp outgoing_def)
         apply(auto simp add: B_out currentD_outside[OF h] max.commute intro!: nn_integral_cong split: split_indicator dest: edge_antiparallel)
         done
       also have "\<dots> = (\<Sum>\<^sup>+ y. f n (\<langle>x\<rangle>, y) * indicator (range Inner) y)"
         by(simp add: nn_integral_add nn_integral_count_space_indicator max.left_commute max.commute)
       also have "\<dots> = d_OUT (f n) \<langle>x\<rangle>"  using B disjoint
         unfolding d_OUT_def by(intro nn_integral_cong)(auto split: split_indicator simp add: notin_range_Inner)
       finally show ?thesis using B by(simp)
     qed
   qed
 
   have "weight \<Gamma> b - d_IN (h 0) b = (SUP n. value_flow \<Psi> (f n))"
     using OUT_f_SOURCE currentD_finite_IN[OF h, of 0 b] IN
     by (simp add: SUP_diff_ennreal less_top)
   also have "(SUP n. value_flow \<Psi> (f n)) \<le> \<alpha>" unfolding \<alpha>_def
     apply(rule SUP_least)
     apply(rule SUP_upper)
     apply(simp add: f)
     done
   also have "\<alpha> \<le> weight \<Gamma> b - d_IN (h 0) b" unfolding \<alpha>_def
   proof(rule SUP_least; clarsimp)
     fix f
     assume f: "flow \<Psi> f"
     have "d_OUT f SOURCE = (\<Sum>\<^sup>+ y. f (SOURCE, y) * indicator {\<langle>b\<rangle>} y)" unfolding d_OUT_def
       apply(rule nn_integral_cong)
       subgoal for x using flowD_capacity[OF f, of "(SOURCE, x)"]
         by(auto split: split_indicator)
       done
     also have "\<dots> = f (SOURCE, \<langle>b\<rangle>)" by(simp add: max_def)
     also have "\<dots> \<le> weight \<Gamma> b - d_IN (h 0) b" using flowD_capacity[OF f, of "(SOURCE, \<langle>b\<rangle>)"] by simp
     finally show "d_OUT f SOURCE \<le> \<dots>" .
   qed
   ultimately have \<alpha>: "\<alpha> = weight \<Gamma> b - d_IN (h 0) b" by(rule antisym[rotated])
   hence \<alpha>_finite: "\<alpha> \<noteq> \<top>" by simp
 
   from \<Psi>.ex_max_flow
   obtain g where g: "flow \<Psi> g"
     and value_g: "value_flow \<Psi> g = \<alpha>"
     and IN_g: "\<And>x. d_IN g x \<le> value_flow \<Psi> g" unfolding \<alpha>_def by blast
 
   have g_le_h0: "g (\<langle>x\<rangle>, \<langle>y\<rangle>) \<le> h 0 (x, y)" if "edge \<Gamma> x y" for x y
     using flowD_capacity[OF g, of "(\<langle>x\<rangle>, \<langle>y\<rangle>)"] that by simp
   note [simp] = \<Psi>.flowD_finite[OF g]
 
   have g_SOURCE: "g (SOURCE, \<langle>x\<rangle>) = (if x = b then \<alpha> else 0)" for x
   proof(cases "x = b")
     case True
     have "g (SOURCE, \<langle>x\<rangle>) = (\<Sum>\<^sup>+ y. g (SOURCE, y) * indicator {\<langle>x\<rangle>} y)" by(simp add: max_def)
     also have "\<dots> = value_flow \<Psi> g" unfolding d_OUT_def using True
       by(intro nn_integral_cong)(auto split: split_indicator intro: \<Psi>.flowD_outside[OF g])
     finally show ?thesis using value_g by(simp add: True)
   qed(simp add: \<Psi>.flowD_outside[OF g])
 
   let ?g = "\<lambda>(x, y). g (\<langle>y\<rangle>, \<langle>x\<rangle>)"
 
   define h' where "h' = h 0 \<oplus> ?g"
   have h'_simps: "h' (x, y) = (if edge \<Gamma> x y then h 0 (x, y) + g (\<langle>y\<rangle>, \<langle>x\<rangle>) - g (\<langle>x\<rangle>, \<langle>y\<rangle>) else 0)" for x y
     by(simp add: h'_def)
 
   have OUT_h'_B [simp]: "d_OUT h' x = 0" if "x \<in> B \<Gamma>" for x using that unfolding d_OUT_def
     by(simp add: nn_integral_0_iff emeasure_count_space_eq_0)(simp add: h'_simps B_out)
   have IN_h'_A [simp]: "d_IN h' x = 0" if "x \<in> A \<Gamma>" for x using that unfolding d_IN_def
     by(simp add: nn_integral_0_iff emeasure_count_space_eq_0)(simp add: h'_simps A_in)
   have h'_outside: "h' e = 0" if "e \<notin> \<^bold>E" for e unfolding h'_def using that by(rule plus_flow_outside)
   have OUT_h'_outside: "d_OUT h' x = 0" and IN_h'_outside: "d_IN h' x = 0" if "x \<notin> \<^bold>V" for x using that
     by(auto simp add: d_OUT_def d_IN_def nn_integral_0_iff emeasure_count_space_eq_0 vertex_def intro: h'_outside)
 
   have g_le_OUT: "g (SINK, \<langle>x\<rangle>) \<le> d_OUT g \<langle>x\<rangle>" for x
     by (subst flowD_KIR[OF g]) (simp_all add: d_IN_ge_point)
 
   have OUT_g_A: "d_OUT ?g x = d_OUT g \<langle>x\<rangle> - g (SINK, \<langle>x\<rangle>)" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_OUT ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (y, \<langle>x\<rangle>))"
       by(simp add: nn_integral_count_space_reindex d_OUT_def)
     also have "\<dots> = d_IN g \<langle>x\<rangle> - (\<Sum>\<^sup>+ y. g (y, \<langle>x\<rangle>) * indicator {SINK} y)" unfolding d_IN_def
       using that b disjoint flowD_capacity[OF g, of "(SOURCE, \<langle>x\<rangle>)"]
       by(subst nn_integral_diff[symmetric])
         (auto simp add: nn_integral_count_space_indicator notin_range_Inner max_def intro!: nn_integral_cong split: split_indicator if_split_asm)
     also have "\<dots> = d_OUT g \<langle>x\<rangle> - g (SINK, \<langle>x\<rangle>)" by(simp add: flowD_KIR[OF g] max_def)
     finally show ?thesis .
   qed
   have IN_g_A: "d_IN ?g x = d_OUT g \<langle>x\<rangle> - g (\<langle>x\<rangle>, SINK)" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_IN ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (\<langle>x\<rangle>, y))"
       by(simp add: nn_integral_count_space_reindex d_IN_def)
     also have "\<dots> = d_OUT g \<langle>x\<rangle> - (\<Sum>\<^sup>+ y. g (\<langle>x\<rangle>, y) * indicator {SINK} y)" unfolding d_OUT_def
       using that b disjoint flowD_capacity[OF g, of "(\<langle>x\<rangle>, SOURCE)"]
       by(subst nn_integral_diff[symmetric])
         (auto simp add: nn_integral_count_space_indicator notin_range_Inner max_def intro!: nn_integral_cong split: split_indicator if_split_asm)
     also have "\<dots> = d_OUT g \<langle>x\<rangle> - g (\<langle>x\<rangle>, SINK)" by(simp add: max_def)
     finally show ?thesis .
   qed
   have OUT_g_B: "d_OUT ?g x = d_IN g \<langle>x\<rangle> - g (SOURCE, \<langle>x\<rangle>)" if "x \<in> B \<Gamma>" for x
   proof -
     have "d_OUT ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (y, \<langle>x\<rangle>))"
       by(simp add: nn_integral_count_space_reindex d_OUT_def)
     also have "\<dots> = d_IN g \<langle>x\<rangle> - (\<Sum>\<^sup>+ y. g (y, \<langle>x\<rangle>) * indicator {SOURCE} y)" unfolding d_IN_def
       using that b disjoint flowD_capacity[OF g, of "(SINK, \<langle>x\<rangle>)"]
       by(subst nn_integral_diff[symmetric])
         (auto simp add: nn_integral_count_space_indicator notin_range_Inner max_def intro!: nn_integral_cong split: split_indicator if_split_asm)
     also have "\<dots> = d_IN g \<langle>x\<rangle> - g (SOURCE, \<langle>x\<rangle>)" by(simp add: max_def)
     finally show ?thesis .
   qed
   have IN_g_B: "d_IN ?g x = d_OUT g \<langle>x\<rangle>" if "x \<in> B \<Gamma>" for x
   proof -
     have "d_IN ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (\<langle>x\<rangle>, y))"
       by(simp add: nn_integral_count_space_reindex d_IN_def)
     also have "\<dots> = d_OUT g \<langle>x\<rangle>" unfolding d_OUT_def using that disjoint
       by(auto 4 3 simp add: nn_integral_count_space_indicator notin_range_Inner intro!: nn_integral_cong \<Psi>.flowD_outside[OF g] split: split_indicator)
     finally show ?thesis .
   qed
 
   have finite_g_IN: "d_IN ?g x \<noteq> \<top>" for x using \<alpha>_finite
   proof(rule neq_top_trans)
     have "d_IN ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (\<langle>x\<rangle>, y))"
       by(auto simp add: d_IN_def nn_integral_count_space_reindex)
     also have "\<dots> \<le> d_OUT g \<langle>x\<rangle>" unfolding d_OUT_def
       by(auto simp add: nn_integral_count_space_indicator intro!: nn_integral_mono split: split_indicator)
     also have "\<dots> = d_IN g \<langle>x\<rangle>" by(rule flowD_KIR[OF g]) simp_all
     also have "\<dots> \<le> \<alpha>" using IN_g value_g by simp
     finally show "d_IN ?g x \<le> \<alpha>" .
   qed
 
   have OUT_h'_A: "d_OUT h' x = d_OUT (h 0) x + g (\<langle>x\<rangle>, SINK) - g (SINK, \<langle>x\<rangle>)" if "x \<in> A \<Gamma>" for x
   proof -
     have "d_OUT h' x = d_OUT (h 0) x + (\<Sum>\<^sup>+ y. ?g (x, y) * indicator \<^bold>E (x, y)) - (\<Sum>\<^sup>+ y. ?g (y, x) * indicator \<^bold>E (x, y))"
       unfolding h'_def
       apply(subst OUT_plus_flow[of \<Gamma> "h 0" ?g, OF currentD_outside'[OF h]])
       apply(auto simp add: g_le_h0 finite_g_IN)
       done
     also have "(\<Sum>\<^sup>+ y. ?g (x, y) * indicator \<^bold>E (x, y)) = d_OUT ?g x" unfolding d_OUT_def using that
       by(auto simp add: A_in split: split_indicator intro!: nn_integral_cong \<Psi>.flowD_outside[OF g])
     also have "\<dots>  = d_OUT g \<langle>x\<rangle> - g (SINK, \<langle>x\<rangle>)" using that by(rule OUT_g_A)
     also have "(\<Sum>\<^sup>+ y. ?g (y, x) * indicator \<^bold>E (x, y)) = d_IN ?g x" using that unfolding d_IN_def
       by(auto simp add: A_in split: split_indicator intro!: nn_integral_cong \<Psi>.flowD_outside[OF g])
     also have "\<dots> = d_OUT g \<langle>x\<rangle> - g (\<langle>x\<rangle>, SINK)" using that by(rule IN_g_A)
     also have "d_OUT (h 0) x + (d_OUT g \<langle>x\<rangle> - g (SINK, \<langle>x\<rangle>)) - \<dots> = d_OUT (h 0) x + g (\<langle>x\<rangle>, SINK) - g (SINK, \<langle>x\<rangle>)"
       apply(simp add: g_le_OUT add_diff_eq_ennreal d_OUT_ge_point)
       apply(subst diff_diff_commute_ennreal)
       apply(simp add: add_increasing d_OUT_ge_point g_le_OUT diff_diff_ennreal')
       apply(subst add.assoc)
       apply(subst (2) add.commute)
       apply(subst add.assoc[symmetric])
       apply(subst ennreal_add_diff_cancel_right)
       apply(simp_all add: \<Psi>.flowD_finite_OUT[OF g])
       done
     finally show ?thesis .
   qed
 
   have finite_g_OUT: "d_OUT ?g x \<noteq> \<top>" for x using \<alpha>_finite
   proof(rule neq_top_trans)
     have "d_OUT ?g x = (\<Sum>\<^sup>+ y\<in>range Inner. g (y, \<langle>x\<rangle>))"
       by(auto simp add: d_OUT_def nn_integral_count_space_reindex)
     also have "\<dots> \<le> d_IN g \<langle>x\<rangle>" unfolding d_IN_def
       by(auto simp add: nn_integral_count_space_indicator intro!: nn_integral_mono split: split_indicator)
     also have "\<dots> \<le> \<alpha>" using IN_g value_g by simp
     finally show "d_OUT ?g x \<le> \<alpha>" .
   qed
 
   have IN_h'_B: "d_IN h' x = d_IN (h 0) x + g (SOURCE, \<langle>x\<rangle>)" if "x \<in> B \<Gamma>" for x
   proof -
     have g_le: "g (SOURCE, \<langle>x\<rangle>) \<le> d_IN g \<langle>x\<rangle>"
       by (rule d_IN_ge_point)
 
     have "d_IN h' x = d_IN (h 0) x + (\<Sum>\<^sup>+ y. g (\<langle>x\<rangle>, \<langle>y\<rangle>) * indicator \<^bold>E (y, x)) - (\<Sum>\<^sup>+ y. g (\<langle>y\<rangle>, \<langle>x\<rangle>) * indicator \<^bold>E (y, x))"
       unfolding h'_def
       by(subst IN_plus_flow[of \<Gamma> "h 0" ?g, OF currentD_outside'[OF h]])
         (auto simp add: g_le_h0 finite_g_OUT)
     also have "(\<Sum>\<^sup>+ y. g (\<langle>x\<rangle>, \<langle>y\<rangle>) * indicator \<^bold>E (y, x)) = d_IN ?g x" unfolding d_IN_def using that
       by(intro nn_integral_cong)(auto split: split_indicator intro!: \<Psi>.flowD_outside[OF g] simp add: B_out)
     also have "\<dots> = d_OUT g \<langle>x\<rangle>" using that by(rule IN_g_B)
     also have "(\<Sum>\<^sup>+ y. g (\<langle>y\<rangle>, \<langle>x\<rangle>) * indicator \<^bold>E (y, x)) = d_OUT ?g x" unfolding d_OUT_def using that
       by(intro nn_integral_cong)(auto split: split_indicator intro!: \<Psi>.flowD_outside[OF g] simp add: B_out)
     also have "\<dots> = d_IN g \<langle>x\<rangle> - g (SOURCE, \<langle>x\<rangle>)" using that by(rule OUT_g_B)
     also have "d_IN (h 0) x + d_OUT g \<langle>x\<rangle> - \<dots> = d_IN (h 0) x + g (SOURCE, \<langle>x\<rangle>)"
       using \<Psi>.flowD_finite_IN[OF g] g_le
       by(cases "d_IN (h 0) x"; cases "d_IN g \<langle>x\<rangle>"; cases "d_IN g \<langle>x\<rangle>"; cases "g (SOURCE, \<langle>x\<rangle>)")
         (auto simp: flowD_KIR[OF g] top_add ennreal_minus_if ennreal_plus_if simp del: ennreal_plus)
     finally show ?thesis .
   qed
 
   have h': "current \<Gamma> h'"
   proof
     fix x
     consider (A) "x \<in> A \<Gamma>" | (B) "x \<in> B \<Gamma>" | (outside) "x \<notin> \<^bold>V" using bipartite_V by auto
     note cases = this
 
     show "d_OUT h' x \<le> weight \<Gamma> x"
     proof(cases rule: cases)
       case A
       then have "d_OUT h' x = d_OUT (h 0) x + g (\<langle>x\<rangle>, SINK) - g (SINK, \<langle>x\<rangle>)" by(simp add: OUT_h'_A)
       also have "\<dots> \<le> d_OUT (h 0) x + g (\<langle>x\<rangle>, SINK)" by(rule diff_le_self_ennreal)
       also have "g (\<langle>x\<rangle>, SINK) \<le> weight \<Gamma> x - d_OUT (h 0) x"
         using flowD_capacity[OF g, of "(\<langle>x\<rangle>, SINK)"] A by simp
       also have "d_OUT (h 0) x + \<dots> = weight \<Gamma> x"
         by(simp add: add_diff_eq_ennreal add_diff_inverse_ennreal  currentD_finite_OUT[OF h] currentD_weight_OUT[OF h])
       finally show ?thesis by(simp add: add_left_mono)
     qed(simp_all add: OUT_h'_outside )
 
     show "d_IN h' x \<le> weight \<Gamma> x"
     proof(cases rule: cases)
       case B
       hence "d_IN h' x = d_IN (h 0) x + g (SOURCE, \<langle>x\<rangle>)" by(rule IN_h'_B)
       also have "\<dots> \<le> weight \<Gamma> x"
         by(simp add: g_SOURCE \<alpha> currentD_weight_IN[OF h] add_diff_eq_ennreal add_diff_inverse_ennreal currentD_finite_IN[OF h])
       finally show ?thesis .
     qed(simp_all add:  IN_h'_outside)
   next
     show "h' e = 0" if "e \<notin> \<^bold>E" for e using that by(simp split: prod.split_asm add: h'_simps)
   qed
   moreover
   have SAT_h': "B \<Gamma> \<inter> \<^bold>V \<subseteq> SAT \<Gamma> h'"
   proof
     show "x \<in> SAT \<Gamma> h'" if "x \<in> B \<Gamma> \<inter> \<^bold>V" for x using that
     proof(cases "x = b")
       case True
       have "d_IN h' x = weight \<Gamma> x" using that True
         by(simp add: IN_h'_B g_SOURCE \<alpha> currentD_weight_IN[OF h] add_diff_eq_ennreal add_diff_inverse_ennreal currentD_finite_IN[OF h])
       thus ?thesis by(simp add: SAT.simps)
     next
       case False
       have "d_IN h' x = d_IN (h 0) x" using that False by(simp add: IN_h'_B g_SOURCE)
       also have "\<dots> = weight \<Gamma> x"
         using SAT[of 0, THEN subsetD, of x] False that currentD_SAT[OF h, of x 0] disjoint by auto
       finally show ?thesis by(simp add: SAT.simps)
     qed
   qed
   moreover
   have "wave \<Gamma> h'"
   proof
     have "separating \<Gamma> (B \<Gamma> \<inter> \<^bold>V)"
     proof
       fix x y p
       assume x: "x \<in> A \<Gamma>" and y: "y \<in> B \<Gamma>" and p: "path \<Gamma> x p y"
       hence Nil: "p \<noteq> []" using disjoint by(auto simp add: rtrancl_path_simps)
       from rtrancl_path_last[OF p Nil] last_in_set[OF Nil] y rtrancl_path_Range[OF p, of y]
       show "(\<exists>z\<in>set p. z \<in> B \<Gamma> \<inter> \<^bold>V) \<or> x \<in> B \<Gamma> \<inter> \<^bold>V" by(auto intro: vertexI2)
     qed
     moreover have TER: "B \<Gamma> \<inter> \<^bold>V \<subseteq> TER h'" using SAT_h' by(auto simp add: SINK)
     ultimately show "separating \<Gamma> (TER h')" by(rule separating_weakening)
   qed(rule h')
   ultimately show ?thesis by blast
 qed
 
 end
 
 lemma countable_bipartite_web_reduce_weight:
   assumes "weight \<Gamma> x \<ge> w"
   shows "countable_bipartite_web (reduce_weight \<Gamma> x w)"
 using bipartite_V A_vertex bipartite_E disjoint assms
 by unfold_locales (auto 4 3 simp add: weight_outside )
 
 lemma unhinder: \<comment> \<open>Lemma 6.9\<close>
   assumes loose: "loose \<Gamma>"
   and b: "b \<in> B \<Gamma>"
   and wb: "weight \<Gamma> b > 0"
   and \<delta>: "\<delta> > 0"
   shows "\<exists>\<epsilon>>0. \<epsilon> < \<delta> \<and> \<not> hindered (reduce_weight \<Gamma> b \<epsilon>)"
 proof(rule ccontr)
   assume "\<not> ?thesis"
   hence hindered: "hindered (reduce_weight \<Gamma> b \<epsilon>)" if "\<epsilon> > 0" "\<epsilon> < \<delta>" for \<epsilon> using that by simp
 
   from b disjoint have bnA: "b \<notin> A \<Gamma>" by blast
 
   define wb where "wb = enn2real (weight \<Gamma> b)"
   have wb_conv: "weight \<Gamma> b = ennreal wb" by(simp add: wb_def less_top[symmetric])
   have wb_pos: "wb > 0" using wb by(simp add: wb_conv)
 
   define \<epsilon> where "\<epsilon> n = min \<delta> wb / (n + 2)" for n :: nat
   have \<epsilon>_pos: "\<epsilon> n > 0" for n using wb_pos \<delta> by(simp add: \<epsilon>_def)
   have \<epsilon>_nonneg: "0 \<le> \<epsilon> n" for n using \<epsilon>_pos[of n] by simp
   have *: "\<epsilon> n \<le> min wb \<delta> / 2" for n using wb_pos \<delta>
     by(auto simp add: \<epsilon>_def field_simps min_def)
   have \<epsilon>_le: "\<epsilon> n \<le> wb" and \<epsilon>_less: "\<epsilon> n < wb" and \<epsilon>_less_\<delta>: "\<epsilon> n < \<delta>" and \<epsilon>_le': "\<epsilon> n \<le> wb / 2" for n
     using *[of n] \<epsilon>_pos[of n] by(auto)
 
   define \<Gamma>' where "\<Gamma>' n = reduce_weight \<Gamma> b (\<epsilon> n)" for n :: nat
   have \<Gamma>'_sel [simp]:
     "edge (\<Gamma>' n) = edge \<Gamma>"
     "A (\<Gamma>' n) = A \<Gamma>"
     "B (\<Gamma>' n) = B \<Gamma>"
     "weight (\<Gamma>' n) x = weight \<Gamma> x - (if x = b then \<epsilon> n else 0)"
     "essential (\<Gamma>' n) = essential \<Gamma>"
     "roofed_gen (\<Gamma>' n) = roofed_gen \<Gamma>"
     for n x by(simp_all add: \<Gamma>'_def)
 
   have vertex_\<Gamma>' [simp]: "vertex (\<Gamma>' n) = vertex \<Gamma>" for n
     by(simp add: vertex_def fun_eq_iff)
 
   from wb have "b \<in> \<^bold>V" using weight_outside[of b] by(auto intro: ccontr)
   interpret \<Gamma>': countable_bipartite_web "\<Gamma>' n" for n unfolding \<Gamma>'_def
     using wb_pos by(intro countable_bipartite_web_reduce_weight)(simp_all add: wb_conv \<epsilon>_le \<epsilon>_nonneg)
 
   obtain g where g: "\<And>n. current (\<Gamma>' n) (g n)"
     and w: "\<And>n. wave (\<Gamma>' n) (g n)"
     and hind: "\<And>n. hindrance (\<Gamma>' n) (g n)" using hindered[OF \<epsilon>_pos, unfolded wb_conv ennreal_less_iff, OF \<epsilon>_less_\<delta>]
     unfolding hindered.simps \<Gamma>'_def by atomize_elim metis
   from g have g\<Gamma>: "current \<Gamma> (g n)" for n
     by(rule current_weight_mono)(auto simp add: \<epsilon>_nonneg diff_le_self_ennreal)
   note [simp] = currentD_finite[OF g\<Gamma>]
 
   have b_TER: "b \<in> TER\<^bsub>\<Gamma>' n\<^esub> (g n)" for n
   proof(rule ccontr)
     assume b': "b \<notin> TER\<^bsub>\<Gamma>' n\<^esub> (g n)"
     then have TER: "TER\<^bsub>\<Gamma>' n\<^esub> (g n) = TER (g n)" using b \<epsilon>_nonneg[of n]
       by(auto simp add: SAT.simps split: if_split_asm intro: ennreal_diff_le_mono_left)
     from w[of n] TER have "wave \<Gamma> (g n)" by(simp add: wave.simps separating_gen.simps)
     moreover have "hindrance \<Gamma> (g n)" using hind[of n] TER bnA b'
       by(auto simp add: hindrance.simps split: if_split_asm)
     ultimately show False using loose_unhindered[OF loose] g\<Gamma>[of n] by(auto intro: hindered.intros)
   qed
 
   have IN_g_b: "d_IN (g n) b = weight \<Gamma> b - \<epsilon> n" for n using b_TER[of n] bnA
     by(auto simp add: currentD_SAT[OF g])
 
   define factor where "factor n = (wb - \<epsilon> 0) / (wb - \<epsilon> n)" for n
   have factor_le_1: "factor n \<le> 1" for n using wb_pos \<delta> \<epsilon>_less[of n]
     by(auto simp add: factor_def field_simps \<epsilon>_def min_def)
   have factor_pos: "0 < factor n" for n using wb_pos \<delta> * \<epsilon>_less by(simp add: factor_def field_simps)
   have factor: "(wb - \<epsilon> n) * factor n = wb - \<epsilon> 0" for n using \<epsilon>_less[of n]
     by(simp add: factor_def field_simps)
 
   define g' where "g' = (\<lambda>n (x, y). if y = b then g n (x, y) * factor n else g n (x, y))"
   have g'_simps: "g' n (x, y) = (if y = b then g n (x, y) * factor n else g n (x, y))" for n x y by(simp add: g'_def)
   have g'_le_g: "g' n e \<le> g n e" for n e using factor_le_1[of n]
     by(cases e "g n e" rule: prod.exhaust[case_product ennreal_cases])
       (auto simp add: g'_simps field_simps mult_left_le)
 
   have "4 + (n * 6 + n * (n * 2)) \<noteq> (0 :: real)" for n :: nat
     by(metis (mono_tags, opaque_lifting) add_is_0 of_nat_eq_0_iff of_nat_numeral zero_neq_numeral)
   then have IN_g': "d_IN (g' n) x = (if x = b then weight \<Gamma> b - \<epsilon> 0 else d_IN (g n) x)" for x n
     using b_TER[of n] bnA factor_pos[of n] factor[of n] wb_pos \<delta>
     by(auto simp add: d_IN_def g'_simps nn_integral_divide nn_integral_cmult currentD_SAT[OF g] wb_conv \<epsilon>_def field_simps
                       ennreal_minus ennreal_mult'[symmetric] intro!: arg_cong[where f=ennreal])
   have OUT_g': "d_OUT (g' n) x = d_OUT (g n) x - g n (x, b) * (1 - factor n)" for n x
   proof -
     have "d_OUT (g' n) x = (\<Sum>\<^sup>+ y. g n (x, y)) - (\<Sum>\<^sup>+ y. (g n (x, y) * (1 - factor n)) * indicator {b} y)"
       using factor_le_1[of n] factor_pos[of n]
       apply(cases "g n (x, b)")
       apply(subst nn_integral_diff[symmetric])
       apply(auto simp add: g'_simps nn_integral_divide d_OUT_def AE_count_space mult_left_le ennreal_mult_eq_top_iff
                            ennreal_mult'[symmetric] ennreal_minus_if
                  intro!: nn_integral_cong split: split_indicator)
       apply(simp_all add: field_simps)
       done
     also have "\<dots> = d_OUT (g n) x - g n (x, b) * (1 - factor n)" using factor_le_1[of n]
       by(subst nn_integral_indicator_singleton)(simp_all add: d_OUT_def field_simps)
     finally show ?thesis .
   qed
 
   have g': "current (\<Gamma>' 0) (g' n)" for n
   proof
     show "d_OUT (g' n) x \<le> weight (\<Gamma>' 0) x" for x
       using b_TER[of n] currentD_weight_OUT[OF g, of n x] \<epsilon>_le[of 0] factor_le_1[of n]
       by(auto simp add: OUT_g' SINK.simps ennreal_diff_le_mono_left)
     show "d_IN (g' n) x \<le> weight (\<Gamma>' 0) x" for x
       using d_IN_mono[of "g' n" x, OF g'_le_g] currentD_weight_IN[OF g, of n x] b_TER[of n] b
       by(auto simp add: IN_g' SAT.simps wb_conv \<epsilon>_def)
     show "g' n e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Gamma>' 0\<^esub>" for e using that by(cases e)(clarsimp simp add: g'_simps currentD_outside[OF g])
   qed
 
   have SINK_g': "SINK (g n) = SINK (g' n)" for n using factor_pos[of n]
     by(auto simp add: SINK.simps currentD_OUT_eq_0[OF g] currentD_OUT_eq_0[OF g'] g'_simps split: if_split_asm)
   have SAT_g': "SAT (\<Gamma>' n) (g n) = SAT (\<Gamma>' 0) (g' n)" for n using b_TER[of n] \<epsilon>_le'[of 0]
     by(auto simp add: SAT.simps wb_conv IN_g' IN_g_b)
   have TER_g': "TER\<^bsub>\<Gamma>' n\<^esub> (g n) = TER\<^bsub>\<Gamma>' 0\<^esub> (g' n)" for n
     using b_TER[of n] by(auto simp add: SAT.simps SINK_g' OUT_g' IN_g' wb_conv \<epsilon>_def)
 
   have w': "wave (\<Gamma>' 0) (g' n)" for n
   proof
     have "separating (\<Gamma>' 0) (TER\<^bsub>\<Gamma>' n\<^esub> (g n))" using waveD_separating[OF w, of n]
       by(simp add: separating_gen.simps)
     then show "separating (\<Gamma>' 0) (TER\<^bsub>\<Gamma>' 0\<^esub> (g' n))" unfolding TER_g' .
   qed(rule g')
 
   define f where "f = rec_nat (g 0) (\<lambda>n rec. rec \<frown>\<^bsub>\<Gamma>' 0\<^esub> g' (n + 1))"
   have f_simps [simp]:
     "f 0 = g 0"
     "f (Suc n) = f n \<frown>\<^bsub>\<Gamma>' 0\<^esub> g' (n + 1)"
     for n by(simp_all add: f_def)
 
   have f: "current (\<Gamma>' 0) (f n)" and fw: "wave (\<Gamma>' 0) (f n)" for n
   proof(induction n)
     case (Suc n)
     { case 1 show ?case unfolding f_simps using Suc.IH g' by(rule current_plus_web) }
     { case 2 show ?case unfolding f_simps using Suc.IH g' w' by(rule wave_plus') }
   qed(simp_all add: g w)
 
   have f_inc: "n \<le> m \<Longrightarrow> f n \<le> f m" for n m
   proof(induction m rule: dec_induct)
     case (step k)
     note step.IH
     also have "f k \<le> (f k \<frown>\<^bsub>\<Gamma>' 0\<^esub> g' (k + 1))"
       by(rule le_funI plus_web_greater)+
     also have "\<dots> = f (Suc k)" by simp
     finally show ?case .
   qed simp
   have chain_f: "Complete_Partial_Order.chain (\<le>) (range f)"
     by(rule chain_imageI[where le_a="(\<le>)"])(simp_all add: f_inc)
   have "countable (support_flow (f n))" for n using current_support_flow[OF f, of n]
     by(rule countable_subset) simp
   hence supp_f: "countable (support_flow (SUP n. f n))" by(subst support_flow_Sup)simp
 
   have RF_f: "RF (TER\<^bsub>\<Gamma>' 0\<^esub> (f n)) = RF (\<Union>i\<le>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i))" for n
   proof(induction n)
     case 0 show ?case by(simp add: TER_g')
   next
     case (Suc n)
     have "RF (TER\<^bsub>\<Gamma>' 0\<^esub> (f (Suc n))) = RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (f n \<frown>\<^bsub>\<Gamma>' 0\<^esub> g' (n + 1)))" by simp
     also have "\<dots> = RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (f n) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' (n + 1)))" using f fw g' w'
       by(rule RF_TER_plus_web)
     also have "\<dots> = RF\<^bsub>\<Gamma>' 0\<^esub> (RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (f n)) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' (n + 1)))"
       by(simp add: roofed_idem_Un1)
     also have "RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (f n)) = RF\<^bsub>\<Gamma>' 0\<^esub> (\<Union>i\<le>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i))" by(simp add: Suc.IH)
     also have "RF\<^bsub>\<Gamma>' 0\<^esub> (\<dots> \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' (n + 1))) = RF\<^bsub>\<Gamma>' 0\<^esub> ((\<Union>i\<le>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i)) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' (n + 1)))"
       by(simp add: roofed_idem_Un1)
     also have "(\<Union>i\<le>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i)) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' (n + 1)) = (\<Union>i\<le>Suc n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i))"
       unfolding atMost_Suc UN_insert by(simp add: Un_commute)
     finally show ?case by simp
   qed
 
   define g\<omega> where "g\<omega> = (SUP n. f n)"
   have g\<omega>: "current (\<Gamma>' 0) g\<omega>" unfolding g\<omega>_def using chain_f
     by(rule current_Sup)(auto simp add: f supp_f)
   have w\<omega>: "wave (\<Gamma>' 0) g\<omega>" unfolding g\<omega>_def using chain_f
     by(rule wave_lub)(auto simp add: fw  supp_f)
   from g\<omega> have g\<omega>': "current (\<Gamma>' n) g\<omega>" for n using wb_pos \<delta>
     by(elim current_weight_mono)(auto simp add: \<epsilon>_le wb_conv \<epsilon>_def field_simps ennreal_minus_if min_le_iff_disj)
 
   have SINK_g\<omega>: "SINK g\<omega> = (\<Inter>n. SINK (f n))" unfolding g\<omega>_def
     by(subst SINK_Sup[OF chain_f])(simp_all add: supp_f)
   have SAT_g\<omega>: "SAT (\<Gamma>' 0) (f n) \<subseteq> SAT (\<Gamma>' 0) g\<omega>" for n
     unfolding g\<omega>_def by(rule SAT_Sup_upper) simp
 
   have g_b_out: "g n (b, x) = 0" for n x using b_TER[of n] by(simp add: SINK.simps currentD_OUT_eq_0[OF g])
   have g'_b_out: "g' n (b, x) = 0" for n x by(simp add: g'_simps g_b_out)
   have "f n (b, x) = 0" for n x by(induction n)(simp_all add: g_b_out g'_b_out)
   hence b_SINK_f: "b \<in> SINK (f n)" for n by(simp add: SINK.simps d_OUT_def)
   hence b_SINK_g\<omega>: "b \<in> SINK g\<omega>" by(simp add: SINK_g\<omega>)
 
   have RF_circ: "RF\<^sup>\<circ>\<^bsub>\<Gamma>' n\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (g' n)) = RF\<^sup>\<circ>\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (g' n))" for n by(simp add: roofed_circ_def)
   have edge_restrict_\<Gamma>': "edge (quotient_web (\<Gamma>' 0) (g' n)) = edge (quotient_web (\<Gamma>' n) (g n))" for n
     by(simp add: fun_eq_iff TER_g' RF_circ)
   have restrict_curr_g': "f \<upharpoonleft> \<Gamma>' 0 / g' n = f \<upharpoonleft> \<Gamma>' n / g n" for n f
     by(simp add: restrict_current_def RF_circ TER_g')
 
   have RF_restrict: "roofed_gen (quotient_web (\<Gamma>' n) (g n)) = roofed_gen (quotient_web (\<Gamma>' 0) (g' n))" for n
     by(simp add: roofed_def fun_eq_iff edge_restrict_\<Gamma>')
 
   have g\<omega>r': "current (quotient_web (\<Gamma>' 0) (g' n)) (g\<omega> \<upharpoonleft> \<Gamma>' 0 / g' n)" for n using w' g\<omega>
     by(rule current_restrict_current)
   have g\<omega>r: "current (quotient_web (\<Gamma>' n) (g n)) (g\<omega> \<upharpoonleft> \<Gamma>' n / g n)" for n using w g\<omega>'
     by(rule current_restrict_current)
   have w\<omega>r: "wave (quotient_web (\<Gamma>' n) (g n)) (g\<omega> \<upharpoonleft> \<Gamma>' n / g n)" (is "wave ?\<Gamma>' ?g\<omega>") for n
   proof
     have *: "wave (quotient_web (\<Gamma>' 0) (g' n)) (g\<omega> \<upharpoonleft> \<Gamma>' 0 / g' n)"
       using g' w' g\<omega> w\<omega> by(rule wave_restrict_current)
     have "d_IN (g\<omega> \<upharpoonleft> \<Gamma>' n / g n) b = 0"
       by(rule d_IN_restrict_current_outside roofed_greaterI b_TER)+
     hence SAT_subset: "SAT (quotient_web (\<Gamma>' 0) (g' n)) (g\<omega> \<upharpoonleft> \<Gamma>' n / g n) \<subseteq> SAT ?\<Gamma>' (g\<omega> \<upharpoonleft> \<Gamma>' n / g n)"
       using b_TER[of n] wb_pos
       by(auto simp add: SAT.simps TER_g' RF_circ wb_conv \<epsilon>_def field_simps
                         ennreal_minus_if split: if_split_asm)
     hence TER_subset: "TER\<^bsub>quotient_web (\<Gamma>' 0) (g' n)\<^esub> (g\<omega> \<upharpoonleft> \<Gamma>' n / g n) \<subseteq> TER\<^bsub>?\<Gamma>'\<^esub> (g\<omega> \<upharpoonleft> \<Gamma>' n / g n)"
       using SINK_g' by(auto simp add: restrict_curr_g')
 
     show "separating ?\<Gamma>' (TER\<^bsub>?\<Gamma>'\<^esub> ?g\<omega>)" (is "separating _ ?TER")
     proof
       fix x y p
       assume xy: "x \<in> A ?\<Gamma>'" "y \<in> B ?\<Gamma>'" and p: "path ?\<Gamma>' x p y"
       from p have p': "path (quotient_web (\<Gamma>' 0) (g' n)) x p y" by(simp add: edge_restrict_\<Gamma>')
       with waveD_separating[OF *, THEN separatingD, simplified, OF p'] TER_g'[of n] SINK_g' SAT_g' restrict_curr_g' SAT_subset xy
       show "(\<exists>z\<in>set p. z \<in> ?TER) \<or> x \<in> ?TER" by auto
     qed
 
     show "d_OUT (g\<omega> \<upharpoonleft> \<Gamma>' n / g n) x = 0" if "x \<notin> RF\<^bsub>?\<Gamma>'\<^esub> ?TER" for x
       unfolding restrict_curr_g'[symmetric] using TER_subset that
       by(intro waveD_OUT[OF *])(auto simp add: TER_g' restrict_curr_g' RF_restrict intro: in_roofed_mono)
   qed
 
   have RF_g\<omega>: "RF (TER\<^bsub>\<Gamma>' 0\<^esub> g\<omega>) = RF (\<Union>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' n))"
   proof -
     have "RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> g\<omega>) = RF (\<Union>i. TER\<^bsub>\<Gamma>' 0\<^esub> (f i))"
       unfolding g\<omega>_def by(subst RF_TER_Sup[OF _ _ chain_f])(auto simp add: f fw supp_f)
     also have "\<dots> = RF (\<Union>i. RF (TER\<^bsub>\<Gamma>' 0\<^esub> (f i)))" by(simp add: roofed_UN)
     also have "\<dots> = RF (\<Union>i. \<Union>j\<le>i. TER\<^bsub>\<Gamma>' 0\<^esub> (g' j))" unfolding RF_f roofed_UN by simp
     also have "(\<Union>i. \<Union>j\<le>i. TER\<^bsub>\<Gamma>' 0\<^esub> (g' j)) = (\<Union>i. TER\<^bsub>\<Gamma>' 0\<^esub> (g' i))" by auto
     finally show ?thesis by simp
   qed
 
   have SAT_plus_\<omega>: "SAT (\<Gamma>' n) (g n \<frown>\<^bsub>\<Gamma>' n\<^esub> g\<omega>) = SAT (\<Gamma>' 0) (g' n \<frown>\<^bsub>\<Gamma>' 0\<^esub> g\<omega>)" for n
     apply(intro set_eqI)
     apply(simp add: SAT.simps IN_plus_current[OF g w g\<omega>r] IN_plus_current[OF g' w' g\<omega>r'] TER_g')
     apply(cases "d_IN (g\<omega> \<upharpoonleft> \<Gamma>' n / g n) b")
     apply(auto simp add: SAT.simps wb_conv d_IN_plus_web IN_g')
     apply(simp_all add: wb_conv IN_g_b restrict_curr_g' \<epsilon>_def field_simps)
     apply(metis TER_g' b_TER roofed_greaterI)+
     done
   have SINK_plus_\<omega>: "SINK (g n \<frown>\<^bsub>\<Gamma>' n\<^esub> g\<omega>) = SINK (g' n \<frown>\<^bsub>\<Gamma>' 0\<^esub> g\<omega>)" for n
     apply(rule set_eqI; simp add: SINK.simps OUT_plus_current[OF g w g\<omega>r] OUT_plus_current[OF g' w'] current_restrict_current[OF w' g\<omega>])
     using factor_pos[of n]
     by(auto simp add: RF_circ TER_g' restrict_curr_g' currentD_OUT_eq_0[OF g] currentD_OUT_eq_0[OF g'] g'_simps split: if_split_asm)
   have TER_plus_\<omega>: "TER\<^bsub>\<Gamma>' n\<^esub> (g n \<frown>\<^bsub>\<Gamma>' n\<^esub> g\<omega>) = TER\<^bsub>\<Gamma>' 0\<^esub> (g' n \<frown>\<^bsub>\<Gamma>' 0\<^esub> g\<omega>)" for n
     by(rule set_eqI iffI)+(simp_all add: SAT_plus_\<omega> SINK_plus_\<omega>)
 
   define h where "h n = g n \<frown>\<^bsub>\<Gamma>' n\<^esub> g\<omega>" for n
   have h: "current (\<Gamma>' n) (h n)" for n unfolding h_def using g w
     by(rule current_plus_current)(rule current_restrict_current[OF w g\<omega>'])
   have hw: "wave (\<Gamma>' n) (h n)" for n unfolding h_def using g w g\<omega>' w\<omega>r by(rule wave_plus)
 
   define T where "T = TER\<^bsub>\<Gamma>' 0\<^esub> g\<omega>"
   have RF_h: "RF (TER\<^bsub>\<Gamma>' n\<^esub> (h n)) = RF T" for n
   proof -
     have "RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' n\<^esub> (h n)) = RF\<^bsub>\<Gamma>' 0\<^esub> (RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> g\<omega>) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' n))"
       unfolding h_def TER_plus_\<omega> RF_TER_plus_web[OF g' w' g\<omega> w\<omega>] roofed_idem_Un1 by(simp add: Un_commute)
     also have "\<dots> = RF ((\<Union>n. TER\<^bsub>\<Gamma>' 0\<^esub> (g' n)) \<union> TER\<^bsub>\<Gamma>' 0\<^esub> (g' n))"
       by(simp add: RF_g\<omega> roofed_idem_Un1)
     also have "\<dots> = RF\<^bsub>\<Gamma>' 0\<^esub> T" unfolding T_def
       by(auto simp add: RF_g\<omega> intro!: arg_cong2[where f=roofed] del: equalityI) auto
     finally show ?thesis by simp
   qed
   have OUT_h_nT: "d_OUT (h n) x = 0" if "x \<notin> RF T" for n x
     by(rule waveD_OUT[OF hw])(simp add: RF_h that)
   have IN_h_nT: "d_IN (h n) x = 0" if "x \<notin> RF T" for n x
     by(rule wave_not_RF_IN_zero[OF h hw])(simp add: RF_h that)
   have OUT_h_b: "d_OUT (h n) b = 0" for n using b_TER[of n] b_SINK_g\<omega>[THEN in_SINK_restrict_current]
     by(auto simp add: h_def OUT_plus_current[OF g w g\<omega>r] SINK.simps)
   have OUT_h_\<E>: "d_OUT (h n) x = 0" if "x \<in> \<E> T" for x n using that
     apply(subst (asm) \<E>_RF[symmetric])
     apply(subst (asm) (1 2) RF_h[symmetric, of n])
     apply(subst (asm) \<E>_RF)
     apply(simp add: SINK.simps)
     done
   have IN_h_\<E>: "d_IN (h n) x = weight (\<Gamma>' n) x" if "x \<in> \<E> T" "x \<notin> A \<Gamma>" for x n using that
     apply(subst (asm) \<E>_RF[symmetric])
     apply(subst (asm) (1 2) RF_h[symmetric, of n])
     apply(subst (asm) \<E>_RF)
     apply(simp add: currentD_SAT[OF h])
     done
 
   have b_SAT: "b \<in> SAT (\<Gamma>' 0) (h 0)" using b_TER[of 0]
     by(auto simp add: h_def SAT.simps d_IN_plus_web intro: order_trans)
   have b_T: "b \<in> T" using b_SINK_g\<omega> b_TER by(simp add: T_def)(metis SAT_g\<omega> subsetD f_simps(1))
 
   have essential: "b \<in> \<E> T"
   proof(rule ccontr)
     assume "b \<notin> \<E> T"
     hence b: "b \<notin> \<E> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0))"
     proof(rule contrapos_nn)
       assume "b \<in> \<E> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0))"
       then obtain p y where p: "path \<Gamma> b p y" and y: "y \<in> B \<Gamma>" and distinct: "distinct (b # p)"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0))" by(rule \<E>_E_RF) auto
       from bypass have bypass': "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> T" unfolding RF_h by(auto intro: roofed_greaterI)
       have "essential \<Gamma> (B \<Gamma>) T b" using p y by(rule essentialI)(auto dest: bypass')
       then show "b \<in> \<E> T" using b_T by simp
     qed
 
     have h0: "current \<Gamma> (h 0)" using h[of 0] by(rule current_weight_mono)(simp_all add: wb_conv \<epsilon>_nonneg)
     moreover have "wave \<Gamma> (h 0)"
     proof
       have "separating (\<Gamma>' 0) (\<E>\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)))" by(rule separating_essential)(rule waveD_separating[OF hw])
       then have "separating \<Gamma> (\<E> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)))" by(simp add: separating_gen.simps)
       moreover have subset: "\<E> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)) \<subseteq> TER (h 0)" using \<epsilon>_nonneg[of 0] b
         by(auto simp add: SAT.simps wb_conv split: if_split_asm)
       ultimately show "separating \<Gamma> (TER (h 0))" by(rule separating_weakening)
     qed(rule h0)
     ultimately have "h 0 = zero_current" by(rule looseD_wave[OF loose])
     then have "d_IN (h 0) b = 0" by(simp)
     with b_SAT wb \<open>b \<notin> A \<Gamma>\<close> show False by(simp add: SAT.simps wb_conv \<epsilon>_def ennreal_minus_if split: if_split_asm)
   qed
 
   define S where "S = {x \<in> RF (T \<inter> B \<Gamma>) \<inter> A \<Gamma>. essential \<Gamma> (T \<inter> B \<Gamma>) (RF (T \<inter> B \<Gamma>) \<inter> A \<Gamma>) x}"
   define \<Gamma>_h where "\<Gamma>_h = \<lparr> edge = \<lambda>x y. edge \<Gamma> x y \<and> x \<in> S \<and> y \<in> T \<and> y \<in> B \<Gamma>, weight = \<lambda>x. weight \<Gamma> x * indicator (S \<union> T \<inter> B \<Gamma>) x, A = S, B = T \<inter> B \<Gamma>\<rparr>"
   have \<Gamma>_h_sel [simp]:
     "edge \<Gamma>_h x y \<longleftrightarrow> edge \<Gamma> x y \<and> x \<in> S \<and> y \<in> T \<and> y \<in> B \<Gamma>"
     "A \<Gamma>_h = S"
     "B \<Gamma>_h = T \<inter> B \<Gamma>"
     "weight \<Gamma>_h x = weight \<Gamma> x * indicator (S \<union> T \<inter> B \<Gamma>) x"
     for x y
     by(simp_all add: \<Gamma>_h_def)
 
   have vertex_\<Gamma>_hD: "x \<in> S \<union> (T \<inter> B \<Gamma>)" if "vertex \<Gamma>_h x" for x
     using that by(auto simp add: vertex_def)
   have S_vertex: "vertex \<Gamma>_h x" if "x \<in> S" for x
   proof -
     from that have a: "x \<in> A \<Gamma>" and RF: "x \<in> RF (T \<inter> B \<Gamma>)" and ess: "essential \<Gamma> (T \<inter> B \<Gamma>) (RF (T \<inter> B \<Gamma>) \<inter> A \<Gamma>) x"
       by(simp_all add: S_def)
     from ess obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and yT: "y \<in> T"
       and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (T \<inter> B \<Gamma>) \<inter> A \<Gamma>" by(rule essentialE_RF)(auto intro: roofed_greaterI)
     from p a y disjoint have "edge \<Gamma> x y"
       by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
     with that y yT show ?thesis by(auto intro!: vertexI1)
   qed
   have OUT_not_S: "d_OUT (h n) x = 0" if "x \<notin> S" for x n
   proof(rule classical)
     assume *: "d_OUT (h n) x \<noteq> 0"
     consider (A) "x \<in> A \<Gamma>" | (B) "x \<in> B \<Gamma>" | (outside) "x \<notin> A \<Gamma>" "x \<notin> B \<Gamma>" by blast
     then show ?thesis
     proof cases
       case B with currentD_OUT[OF h, of x n] show ?thesis by simp
     next
       case outside with currentD_outside_OUT[OF h, of x n] show ?thesis by(simp add: not_vertex)
     next
       case A
       from * obtain y where xy: "h n (x, y) \<noteq> 0" using currentD_OUT_eq_0[OF h, of n x] by auto
       then have edge: "edge \<Gamma> x y" using currentD_outside[OF h] by(auto)
       hence p: "path \<Gamma> x [y] y" by(simp add: rtrancl_path_simps)
 
       from bipartite_E[OF edge] have x: "x \<in> A \<Gamma>" and y: "y \<in> B \<Gamma>" by simp_all
       moreover have "x \<in> RF (RF (T \<inter> B \<Gamma>))"
       proof
         fix p y'
         assume p: "path \<Gamma> x p y'" and y': "y' \<in> B \<Gamma>"
         from p x y' disjoint have py: "p = [y']"
           by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
         have "separating (\<Gamma>' 0) (RF\<^bsub>\<Gamma>' 0\<^esub> (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)))" unfolding separating_RF
           by(rule waveD_separating[OF hw])
         from separatingD[OF this, of x p y'] py p x y'
         have "x \<in> RF T \<or> y' \<in> RF T" by(auto simp add: RF_h)
         thus "(\<exists>z\<in>set p. z \<in> RF (T \<inter> B \<Gamma>)) \<or> x \<in> RF (T \<inter> B \<Gamma>)"
         proof cases
           case right with y' py show ?thesis by(simp add: RF_in_B)
         next
           case left
           have "x \<notin> \<E> T" using OUT_h_\<E>[of x n] xy by(auto simp add: currentD_OUT_eq_0[OF h])
           with left have "x \<in> RF\<^sup>\<circ> T" by(simp add: roofed_circ_def)
           from RF_circ_edge_forward[OF this, of y'] p py have "y' \<in> RF T" by(simp add: rtrancl_path_simps)
           with y' have "y' \<in> T" by(simp add: RF_in_B)
           with y' show ?thesis using py by(auto intro: roofed_greaterI)
         qed
       qed
       moreover have "y \<in> T" using IN_h_nT[of y n] y xy by(auto simp add: RF_in_B currentD_IN_eq_0[OF h])
       with p x y disjoint have "essential \<Gamma> (T \<inter> B \<Gamma>) (RF (T \<inter> B \<Gamma>) \<inter> A \<Gamma>) x" by(auto intro!: essentialI)
       ultimately have "x \<in> S" unfolding roofed_idem by(simp add: S_def)
       with that show ?thesis by contradiction
     qed
   qed
 
   have B_vertex: "vertex \<Gamma>_h y" if T: "y \<in> T" and B: "y \<in> B \<Gamma>" and w: "weight \<Gamma> y > 0" for y
   proof -
     from T B disjoint \<epsilon>_less[of 0] w
     have "d_IN (h 0) y > 0" using IN_h_\<E>[of y 0] by(cases "y \<in> A \<Gamma>")(auto simp add: essential_BI wb_conv ennreal_minus_if)
     then obtain x where xy: "h 0 (x, y) \<noteq> 0" using currentD_IN_eq_0[OF h, of 0 y] by(auto)
     then have edge: "edge \<Gamma> x y" using currentD_outside[OF h] by(auto)
     from xy have "d_OUT (h 0) x \<noteq> 0" by(auto simp add: currentD_OUT_eq_0[OF h])
     hence "x \<in> S" using OUT_not_S[of x 0] by(auto)
     with edge T B show ?thesis by(simp add: vertexI2)
   qed
 
   have \<Gamma>_h: "countable_bipartite_web \<Gamma>_h"
   proof
     show "\<^bold>V\<^bsub>\<Gamma>_h\<^esub> \<subseteq> A \<Gamma>_h \<union> B \<Gamma>_h" by(auto simp add: vertex_def)
     show "A \<Gamma>_h \<subseteq> \<^bold>V\<^bsub>\<Gamma>_h\<^esub>" using S_vertex by auto
     show "x \<in> A \<Gamma>_h \<and> y \<in> B \<Gamma>_h" if "edge \<Gamma>_h x y" for x y using that by auto
     show "A \<Gamma>_h \<inter> B \<Gamma>_h = {}" using disjoint by(auto simp add: S_def)
     have "\<^bold>E\<^bsub>\<Gamma>_h\<^esub> \<subseteq> \<^bold>E" by auto
     thus "countable \<^bold>E\<^bsub>\<Gamma>_h\<^esub>" by(rule countable_subset) simp
     show "weight \<Gamma>_h x \<noteq> \<top>" for x by(simp split: split_indicator)
     show "weight \<Gamma>_h x = 0" if "x \<notin> \<^bold>V\<^bsub>\<Gamma>_h\<^esub>" for x
       using that S_vertex B_vertex[of x]
       by(cases "weight \<Gamma>_h x > 0")(auto split: split_indicator)
   qed
   then interpret \<Gamma>_h: countable_bipartite_web \<Gamma>_h .
 
   have essential_T: "essential \<Gamma> (B \<Gamma>) T = essential \<Gamma> (B \<Gamma>) (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0))"
   proof(rule ext iffI)+
     fix x
     assume "essential \<Gamma> (B \<Gamma>) T x"
     then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and distinct: "distinct (x # p)"
       and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF T" by(rule essentialE_RF)auto
     from bypass have bypass': "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)"
       unfolding RF_h[of 0, symmetric] by(blast intro: roofed_greaterI)
     show "essential \<Gamma> (B \<Gamma>) (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)) x" using p y
       by(blast intro: essentialI dest: bypass')
   next
     fix x
     assume "essential \<Gamma> (B \<Gamma>) (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0)) x"
     then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and distinct: "distinct (x # p)"
       and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER\<^bsub>\<Gamma>' 0\<^esub> (h 0))" by(rule essentialE_RF)auto
     from bypass have bypass': "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> T"
       unfolding RF_h[of 0] by(blast intro: roofed_greaterI)
     show "essential \<Gamma> (B \<Gamma>) T x" using p y
       by(blast intro: essentialI dest: bypass')
   qed
 
   have h': "current \<Gamma>_h (h n)" for n
   proof
     show "d_OUT (h n) x \<le> weight \<Gamma>_h x" for x
       using currentD_weight_OUT[OF h, of n x] \<epsilon>_nonneg[of n] \<Gamma>'.currentD_OUT'[OF h, of x n] OUT_not_S
       by(auto split: split_indicator if_split_asm elim: order_trans intro: diff_le_self_ennreal in_roofed_mono simp add: OUT_h_b  roofed_circ_def)
 
     show "d_IN (h n) x \<le> weight \<Gamma>_h x" for x
       using currentD_weight_IN[OF h, of n x] currentD_IN[OF h, of x n] \<epsilon>_nonneg[of n] b_T b \<Gamma>'.currentD_IN'[OF h, of x n] IN_h_nT[of x n]
       by(cases "x \<in> B \<Gamma>")(auto 4 3 split: split_indicator split: if_split_asm elim: order_trans intro: diff_le_self_ennreal simp add: S_def  roofed_circ_def RF_in_B)
 
     show "h n e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Gamma>_h\<^esub>" for e
       using that OUT_not_S[of "fst e" n] currentD_outside'[OF h, of e n] \<Gamma>'.currentD_IN'[OF h, of "snd e" n] disjoint
       apply(cases "e \<in> \<^bold>E")
       apply(auto split: prod.split_asm simp add: currentD_OUT_eq_0[OF h] currentD_IN_eq_0[OF h])
       apply(cases "fst e \<in> S"; clarsimp simp add: S_def)
       apply(frule RF_circ_edge_forward[rotated])
       apply(erule roofed_circI, blast)
       apply(drule bipartite_E)
       apply(simp add: RF_in_B)
       done
   qed
 
   have SAT_h': "B \<Gamma>_h \<inter> \<^bold>V\<^bsub>\<Gamma>_h\<^esub> - {b} \<subseteq> SAT \<Gamma>_h (h n)" for n
   proof
     fix x
     assume "x \<in> B \<Gamma>_h \<inter> \<^bold>V\<^bsub>\<Gamma>_h\<^esub> - {b}"
     then have x: "x \<in> T" and B: "x \<in> B \<Gamma>" and b: "x \<noteq> b" and vertex: "x \<in> \<^bold>V\<^bsub>\<Gamma>_h\<^esub>" by auto
     from B disjoint have xnA: "x \<notin> A \<Gamma>" by blast
     from x B have "x \<in> \<E> T" by(simp add: essential_BI)
     hence "d_IN (h n) x = weight (\<Gamma>' n) x" using xnA by(rule IN_h_\<E>)
     with xnA b x B show "x \<in> SAT \<Gamma>_h (h n)" by(simp add: currentD_SAT[OF h'])
   qed
   moreover have "b \<in> B \<Gamma>_h" using b essential by simp
   moreover have "(\<lambda>n. min \<delta> wb * (1 / (real (n + 2)))) \<longlonglongrightarrow> 0"
     apply(rule LIMSEQ_ignore_initial_segment)
     apply(rule tendsto_mult_right_zero)
     apply(rule lim_1_over_real_power[where s=1, simplified])
     done
   then have "(INF n. ennreal (\<epsilon> n)) = 0" using wb_pos \<delta>
     apply(simp add: \<epsilon>_def)
     apply(rule INF_Lim)
     apply(rule decseq_SucI)
     apply(simp add: field_simps min_def)
     apply(simp add: add.commute ennreal_0[symmetric] del: ennreal_0)
     done
   then have "(SUP n. d_IN (h n) b) = weight \<Gamma>_h b" using essential b bnA wb IN_h_\<E>[of b]
     by(simp add: SUP_const_minus_ennreal)
   moreover have "d_IN (h 0) b \<le> d_IN (h n) b" for n using essential b bnA wb_pos \<delta> IN_h_\<E>[of b]
     by(simp add: wb_conv \<epsilon>_def field_simps ennreal_minus_if min_le_iff_disj)
   moreover have b_V: "b \<in> \<^bold>V\<^bsub>\<Gamma>_h\<^esub>" using b wb essential by(auto dest: B_vertex)
   ultimately have "\<exists>h'. current \<Gamma>_h h' \<and> wave \<Gamma>_h h' \<and> B \<Gamma>_h \<inter> \<^bold>V\<^bsub>\<Gamma>_h\<^esub> \<subseteq> SAT \<Gamma>_h h'"
     by(rule \<Gamma>_h.unhinder_bipartite[OF h'])
   then obtain h' where h': "current \<Gamma>_h h'" and h'w: "wave \<Gamma>_h h'"
     and B_SAT': "B \<Gamma>_h \<inter> \<^bold>V\<^bsub>\<Gamma>_h\<^esub> \<subseteq> SAT \<Gamma>_h h'" by blast
 
   have h'': "current \<Gamma> h'"
   proof
     show "d_OUT h' x \<le> weight \<Gamma> x" for x using currentD_weight_OUT[OF h', of x]
       by(auto split: split_indicator_asm elim: order_trans intro: )
     show "d_IN h' x \<le> weight \<Gamma> x" for x using currentD_weight_IN[OF h', of x]
       by(auto split: split_indicator_asm elim: order_trans intro: )
     show "h' e = 0" if "e \<notin> \<^bold>E" for e using currentD_outside'[OF h', of e] that by auto
   qed
   moreover have "wave \<Gamma> h'"
   proof
     have "separating (\<Gamma>' 0) T" unfolding T_def by(rule waveD_separating[OF w\<omega>])
     hence "separating \<Gamma> T" by(simp add: separating_gen.simps)
     hence *: "separating \<Gamma> (\<E> T)" by(rule separating_essential)
     show "separating \<Gamma> (TER h')"
     proof
       fix x p y
       assume x: "x \<in> A \<Gamma>" and p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
       from p x y disjoint have py: "p = [y]"
         by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
       from separatingD[OF * p x y] py have "x \<in> \<E> T \<or> y \<in> \<E> T" by auto
       then show "(\<exists>z\<in>set p. z \<in> TER h') \<or> x \<in> TER h'"
       proof cases
         case left
         then have "x \<notin> \<^bold>V\<^bsub>\<Gamma>_h\<^esub>" using x disjoint
           by(auto 4 4 dest!: vertex_\<Gamma>_hD simp add: S_def elim: essentialE_RF intro!: roofed_greaterI dest: roofedD)
         hence "d_OUT h' x = 0" by(intro currentD_outside_OUT[OF h'])
         with x have "x \<in> TER h'" by(auto simp add: SAT.A SINK.simps)
         thus ?thesis ..
       next
         case right
         have "y \<in> SAT \<Gamma> h'"
         proof(cases "weight \<Gamma> y > 0")
           case True
           with py x y right have "vertex \<Gamma>_h y" by(auto intro: B_vertex)
           hence "y \<in> SAT \<Gamma>_h h'" using B_SAT' right y by auto
           with right y disjoint show ?thesis
             by(auto simp add: currentD_SAT[OF h'] currentD_SAT[OF h''] S_def)
         qed(auto simp add: SAT.simps)
         with currentD_OUT[OF h', of y] y right have "y \<in> TER h'" by(auto simp add: SINK)
         thus ?thesis using py by simp
       qed
     qed
   qed(rule h'')
   ultimately have "h' = zero_current" by(rule looseD_wave[OF loose])
   hence "d_IN h' b = 0" by simp
   moreover from essential b b_V B_SAT' have "b \<in> SAT \<Gamma>_h h'" by(auto)
   ultimately show False using wb b essential disjoint by(auto simp add: SAT.simps S_def)
 qed
 
 end
 
 subsection \<open>Single-vertex saturation in unhindered bipartite webs\<close>
 
 text \<open>
   The proof of lemma 6.10 in @{cite "AharoniBergerGeorgakopoulusPerlsteinSpruessel2011JCT"} is flawed.
   The transfinite steps (taking the least upper bound) only preserves unhinderedness, but not looseness.
   However, the single steps to non-limit ordinals assumes that \<open>\<Omega> - f\<^sub>i\<close> is loose in order to
   apply Lemma 6.9.
 
   Counterexample: The bipartite web with three nodes \<open>a\<^sub>1\<close>, \<open>a\<^sub>2\<close>, \<open>a\<^sub>3\<close> in \<open>A\<close>
   and two nodes \<open>b\<^sub>1\<close>, \<open>b\<^sub>2\<close> in \<open>B\<close> and edges \<open>(a\<^sub>1, b\<^sub>1)\<close>, \<open>(a\<^sub>2, b\<^sub>1)\<close>,
   \<open>(a\<^sub>2, b\<^sub>2)\<close>, \<open>(a\<^sub>3, b\<^sub>2)\<close> and weights \<open>a\<^sub>1 = a\<^sub>3 = 1\<close> and \<open>a\<^sub>2 = 2\<close> and
   \<open>b\<^sub>1 = 3\<close> and \<open>b\<^sub>2 = 2\<close>.
   Then, we can get a sequence of weight reductions on \<open>b\<^sub>2\<close> from \<open>2\<close> to \<open>1.5\<close>,
   \<open>1.25\<close>, \<open>1.125\<close>, etc. with limit \<open>1\<close>.
   All maximal waves in the restricted webs in the sequence are @{term [source] zero_current}, so in
   the limit, we get \<open>k = 0\<close> and \<open>\<epsilon> = 1\<close> for \<open>a\<^sub>2\<close> and \<open>b\<^sub>2\<close>. Now, the
   restricted web for the two is not loose because it contains the wave which assigns 1 to \<open>(a\<^sub>3, b\<^sub>2)\<close>.
 
   We prove a stronger version which only assumes and ensures on unhinderedness.
 \<close>
 context countable_bipartite_web begin
 
 lemma web_flow_iff: "web_flow \<Gamma> f \<longleftrightarrow> current \<Gamma> f"
 using bipartite_V by(auto simp add: web_flow.simps)
 
 lemma countable_bipartite_web_minus_web:
   assumes f: "current \<Gamma> f"
   shows "countable_bipartite_web (\<Gamma> \<ominus> f)"
 using bipartite_V A_vertex bipartite_E disjoint currentD_finite_OUT[OF f] currentD_weight_OUT[OF f] currentD_weight_IN[OF f] currentD_outside_OUT[OF f] currentD_outside_IN[OF f]
 by unfold_locales (auto simp add:  weight_outside)
 
 lemma current_plus_current_minus:
   assumes f: "current \<Gamma> f"
   and g: "current (\<Gamma> \<ominus> f) g"
   shows "current \<Gamma> (plus_current f g)" (is "current _ ?fg")
 proof
   interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> f" using f by(rule countable_bipartite_web_minus_web)
   show "d_OUT ?fg x \<le> weight \<Gamma> x" for x
     using currentD_weight_OUT[OF g, of x] currentD_OUT[OF g, of x] currentD_finite_OUT[OF f, of x] currentD_OUT[OF f, of x] currentD_outside_IN[OF f, of x] currentD_outside_OUT[OF f, of x] currentD_weight_OUT[OF f, of x]
     by(cases "x \<in> A \<Gamma> \<or> x \<in> B \<Gamma>")(auto simp add: add.commute d_OUT_def nn_integral_add not_vertex ennreal_le_minus_iff split: if_split_asm)
   show "d_IN ?fg x \<le> weight \<Gamma> x" for x
     using currentD_weight_IN[OF g, of x] currentD_IN[OF g, of x] currentD_finite_IN[OF f, of x] currentD_OUT[OF f, of x] currentD_outside_IN[OF f, of x] currentD_outside_OUT[OF f, of x] currentD_weight_IN[OF f, of x]
     by(cases "x \<in> A \<Gamma> \<or> x \<in> B \<Gamma>")(auto simp add: add.commute  d_IN_def nn_integral_add not_vertex ennreal_le_minus_iff split: if_split_asm)
   show "?fg e = 0" if "e \<notin> \<^bold>E" for e using that currentD_outside'[OF f, of e] currentD_outside'[OF g, of e] by(cases e) simp
 qed
 
 lemma wave_plus_current_minus:
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current (\<Gamma> \<ominus> f) g"
   and w': "wave (\<Gamma> \<ominus> f) g"
   shows "wave \<Gamma> (plus_current f g)" (is "wave _ ?fg")
 proof
   show fg: "current \<Gamma> ?fg" using f g by(rule current_plus_current_minus)
   show sep: "separating \<Gamma> (TER ?fg)"
   proof
     fix x p y
     assume x: "x \<in> A \<Gamma>" and p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     from p x y disjoint have py: "p = [y]"
       by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
     with waveD_separating[THEN separatingD, OF w p x y] have "x \<in> TER f \<or> y \<in> TER f" by auto
     thus "(\<exists>z\<in>set p. z \<in> TER ?fg) \<or> x \<in> TER ?fg"
     proof cases
       case right
       with y disjoint have "y \<in> TER ?fg" using currentD_OUT[OF fg y]
         by(auto simp add: SAT.simps SINK.simps d_IN_def nn_integral_add not_le add_increasing2)
       thus ?thesis using py by simp
     next
       case x': left
       from p have "path (\<Gamma> \<ominus> f) x p y" by simp
       from waveD_separating[THEN separatingD, OF w' this] x y py
       have "x \<in> TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g \<or> y \<in> TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g" by auto
       thus ?thesis
       proof cases
         case left
         hence "x \<in> TER ?fg" using x x'
           by(auto simp add: SAT.simps SINK.simps d_OUT_def nn_integral_add)
         thus ?thesis ..
       next
         case right
         hence "y \<in> TER ?fg" using disjoint y currentD_OUT[OF fg y] currentD_OUT[OF f y] currentD_finite_IN[OF f, of y]
           by(auto simp add: add.commute SINK.simps SAT.simps d_IN_def nn_integral_add ennreal_minus_le_iff split: if_split_asm)
         with py show ?thesis by auto
       qed
     qed
   qed
 qed
 
 lemma minus_plus_current:
   assumes f: "current \<Gamma> f"
   and g: "current (\<Gamma> \<ominus> f) g"
   shows "\<Gamma> \<ominus> plus_current f g = \<Gamma> \<ominus> f \<ominus> g" (is "?lhs = ?rhs")
 proof(rule web.equality)
   have "weight ?lhs x = weight ?rhs x" for x
     using currentD_weight_IN[OF f, of x] currentD_weight_IN[OF g, of x]
     by (auto simp add: d_IN_def d_OUT_def nn_integral_add diff_add_eq_diff_diff_swap_ennreal add_increasing2 diff_add_assoc2_ennreal add.assoc)
   thus "weight ?lhs = weight ?rhs" ..
 qed simp_all
 
 lemma unhindered_minus_web:
   assumes unhindered: "\<not> hindered \<Gamma>"
   and f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   shows "\<not> hindered (\<Gamma> \<ominus> f)"
 proof
   assume "hindered (\<Gamma> \<ominus> f)"
   then obtain g where g: "current (\<Gamma> \<ominus> f) g"
     and w': "wave (\<Gamma> \<ominus> f) g"
     and hind: "hindrance (\<Gamma> \<ominus> f) g" by cases
   let ?fg = "plus_current f g"
   have fg: "current \<Gamma> ?fg" using f g by(rule current_plus_current_minus)
   moreover have "wave \<Gamma> ?fg" using f w g w' by(rule wave_plus_current_minus)
   moreover from hind obtain a where a: "a \<in> A \<Gamma>" and n\<E>: "a \<notin> \<E>\<^bsub>\<Gamma> \<ominus> f\<^esub> (TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g)"
     and wa: "d_OUT g a < weight (\<Gamma> \<ominus> f) a" by cases auto
   from a have "hindrance \<Gamma> ?fg"
   proof
     show "a \<notin> \<E> (TER ?fg)"
     proof
       assume \<E>: "a \<in> \<E> (TER ?fg)"
       then obtain p y where p: "path \<Gamma> a p y" and y: "y \<in> B \<Gamma>"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER ?fg)" by(rule \<E>_E_RF) blast
       from p a y disjoint have py: "p = [y]"
         by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
       from bypass[of y] py have "y \<notin> TER ?fg" by(auto intro: roofed_greaterI)
       with currentD_OUT[OF fg y] have "y \<notin> SAT \<Gamma> ?fg" by(auto simp add: SINK.simps)
       hence "y \<notin> SAT (\<Gamma> \<ominus> f) g" using y currentD_OUT[OF f y] currentD_finite_IN[OF f, of y]
         by(auto simp add: SAT.simps d_IN_def nn_integral_add ennreal_minus_le_iff add.commute)
       hence "essential (\<Gamma> \<ominus> f) (B (\<Gamma> \<ominus> f)) (TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g) a" using p py y
         by(auto intro!: essentialI)
       moreover from \<E> a have "a \<in> TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g"
         by(auto simp add: SAT.A SINK_plus_current)
       ultimately have "a \<in> \<E>\<^bsub>\<Gamma> \<ominus> f\<^esub> (TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g)" by blast
       thus False using n\<E> by contradiction
     qed
     show "d_OUT ?fg a < weight \<Gamma> a" using a wa currentD_finite_OUT[OF f, of a]
       by(simp add: d_OUT_def less_diff_eq_ennreal less_top add.commute nn_integral_add)
   qed
   ultimately have "hindered \<Gamma>" by(blast intro: hindered.intros)
   with unhindered show False by contradiction
 qed
 
 lemma loose_minus_web:
   assumes unhindered: "\<not> hindered \<Gamma>"
   and f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and maximal: "\<And>w. \<lbrakk> current \<Gamma> w; wave \<Gamma> w; f \<le> w \<rbrakk> \<Longrightarrow> f = w"
   shows "loose (\<Gamma> \<ominus> f)" (is "loose ?\<Gamma>")
 proof
   fix g
   assume g: "current ?\<Gamma> g" and w': "wave ?\<Gamma> g"
   let ?g = "plus_current f g"
   from f g have "current \<Gamma> ?g" by(rule current_plus_current_minus)
   moreover from f w g w' have "wave \<Gamma> ?g" by(rule wave_plus_current_minus)
   moreover have "f \<le> ?g" by(clarsimp simp add: le_fun_def)
   ultimately have eq: "f = ?g" by(rule maximal)
   have "g e = 0" for e
   proof(cases e)
     case (Pair x y)
     have "f e \<le> d_OUT f x" unfolding d_OUT_def Pair by(rule nn_integral_ge_point) simp
     also have "\<dots> \<le> weight \<Gamma> x" by(rule currentD_weight_OUT[OF f])
     also have "\<dots> < \<top>" by(simp add: less_top[symmetric])
     finally show "g e = 0" using Pair eq[THEN fun_cong, of e]
       by(cases "f e" "g e" rule: ennreal2_cases)(simp_all add: fun_eq_iff)
   qed
   thus "g = (\<lambda>_. 0)" by(simp add: fun_eq_iff)
 next
   show "\<not> hindrance ?\<Gamma> zero_current" using unhindered
   proof(rule contrapos_nn)
     assume "hindrance ?\<Gamma> zero_current"
     then obtain x where a: "x \<in> A ?\<Gamma>" and \<E>: "x \<notin> \<E>\<^bsub>?\<Gamma>\<^esub> (TER\<^bsub>?\<Gamma>\<^esub> zero_current)"
       and weight: "d_OUT zero_current x < weight ?\<Gamma> x" by cases
     have "hindrance \<Gamma> f"
     proof
       show a': "x \<in> A \<Gamma>" using a by simp
       with weight show "d_OUT f x < weight \<Gamma> x"
         by(simp add: less_diff_eq_ennreal less_top[symmetric] currentD_finite_OUT[OF f])
       show "x \<notin> \<E> (TER f)"
       proof
         assume "x \<in> \<E> (TER f)"
         then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
           and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)" by(rule \<E>_E_RF) auto
         from p a' y disjoint have py: "p = [y]"
           by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
         hence "y \<notin> (TER f)" using bypass[of y] by(auto intro: roofed_greaterI)
         hence "weight ?\<Gamma> y > 0" using currentD_OUT[OF f y] disjoint y
           by(auto simp add: SINK.simps SAT.simps diff_gr0_ennreal)
         hence "y \<notin> TER\<^bsub>?\<Gamma>\<^esub> zero_current" using y disjoint by(auto)
         hence "essential ?\<Gamma> (B ?\<Gamma>) (TER\<^bsub>?\<Gamma>\<^esub> zero_current) x" using p y py by(auto intro!: essentialI)
         with a have "x \<in> \<E>\<^bsub>?\<Gamma>\<^esub> (TER\<^bsub>?\<Gamma>\<^esub> zero_current)" by simp
         with \<E> show False by contradiction
       qed
     qed
     thus "hindered \<Gamma>" using f w ..
   qed
 qed
 
 lemma weight_minus_web:
   assumes f: "current \<Gamma> f"
   shows "weight (\<Gamma> \<ominus> f) x = (if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT f x else weight \<Gamma> x - d_IN f x)"
 proof(cases "x \<in> B \<Gamma>")
   case True
   with currentD_OUT[OF f True] disjoint show ?thesis by auto
 next
   case False
   hence "d_IN f x = 0" "d_OUT f x = 0" if "x \<notin> A \<Gamma>"
     using currentD_outside_OUT[OF f, of x] currentD_outside_IN[OF f, of x] bipartite_V that by auto
   then show ?thesis by simp
 qed
 
 
 lemma (in -) separating_minus_web [simp]: "separating_gen (G \<ominus> f) = separating_gen G"
 by(simp add: separating_gen.simps fun_eq_iff)
 
 lemma current_minus:
   assumes f: "current \<Gamma> f"
   and g: "current \<Gamma> g"
   and le: "\<And>e. g e \<le> f e"
   shows "current (\<Gamma> \<ominus> g) (f - g)"
 proof -
   interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> g" using g by(rule countable_bipartite_web_minus_web)
   note [simp del] = minus_web_sel(2)
     and [simp] = weight_minus_web[OF g]
   show ?thesis
   proof
     show "d_OUT (f - g) x \<le> weight (\<Gamma> \<ominus> g) x" for x unfolding fun_diff_def
       using currentD_weight_OUT[OF f, of x] currentD_weight_IN[OF g, of x]
       by(subst d_OUT_diff)(simp_all add: le currentD_finite_OUT[OF g] currentD_OUT'[OF f] currentD_OUT'[OF g] ennreal_minus_mono)
     show "d_IN (f - g) x \<le> weight (\<Gamma> \<ominus> g) x" for x unfolding fun_diff_def
       using currentD_weight_IN[OF f, of x] currentD_weight_OUT[OF g, of x]
       by(subst d_IN_diff)(simp_all add: le currentD_finite_IN[OF g] currentD_IN[OF f] currentD_IN[OF g] ennreal_minus_mono)
     show "(f - g) e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Gamma> \<ominus> g\<^esub>" for e using that currentD_outside'[OF f] currentD_outside'[OF g] by simp
   qed
 qed
 
 lemma
   assumes w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
   and le: "\<And>e. g e \<le> f e"
   shows wave_minus: "wave (\<Gamma> \<ominus> g) (f - g)"
   and TER_minus: "TER f \<subseteq> TER\<^bsub>\<Gamma> \<ominus> g\<^esub> (f - g)"
 proof
   have "x \<in> SINK f \<Longrightarrow> x \<in> SINK (f - g)" for x using d_OUT_mono[of g _ f, OF le, of x]
     by(auto simp add: SINK.simps fun_diff_def d_OUT_diff le currentD_finite_OUT[OF g])
   moreover have "x \<in> SAT \<Gamma> f \<Longrightarrow> x \<in> SAT (\<Gamma> \<ominus> g) (f - g)" for x
     by(auto simp add: SAT.simps currentD_OUT'[OF g] fun_diff_def d_IN_diff le currentD_finite_IN[OF g] ennreal_minus_mono)
   ultimately show TER: "TER f \<subseteq> TER\<^bsub>\<Gamma> \<ominus> g\<^esub> (f - g)" by(auto)
 
   from w have "separating \<Gamma> (TER f)" by(rule waveD_separating)
   thus "separating (\<Gamma> \<ominus> g) (TER\<^bsub>\<Gamma> \<ominus> g\<^esub> (f - g))" using TER by(simp add: separating_weakening)
 
   fix x
   assume "x \<notin> RF\<^bsub>\<Gamma> \<ominus> g\<^esub> (TER\<^bsub>\<Gamma> \<ominus> g\<^esub> (f - g))"
   hence "x \<notin> RF (TER f)" using TER by(auto intro: in_roofed_mono)
   hence "d_OUT f x = 0" by(rule waveD_OUT[OF w])
   moreover have "0 \<le> f e" for e using le[of e] by simp
   ultimately show "d_OUT (f - g) x = 0" unfolding d_OUT_def
     by(simp add: nn_integral_0_iff emeasure_count_space_eq_0)
 qed
 
 lemma (in -) essential_minus_web [simp]: "essential (\<Gamma> \<ominus> f) = essential \<Gamma>"
 by(simp add: essential_def fun_eq_iff)
 
 lemma (in -) RF_in_essential: fixes B shows "essential \<Gamma> B S x \<Longrightarrow> x \<in> roofed_gen \<Gamma> B S \<longleftrightarrow> x \<in> S"
 by(auto intro: roofed_greaterI elim!: essentialE_RF dest: roofedD)
 
 lemma (in -) d_OUT_fun_upd:
   assumes "f (x, y) \<noteq> \<top>" "f (x, y) \<ge> 0" "k \<noteq> \<top>" "k \<ge> 0"
   shows "d_OUT (f((x, y) := k)) x' = (if x = x' then d_OUT f x - f (x, y) + k else d_OUT f x')"
   (is "?lhs = ?rhs")
 proof(cases "x = x'")
   case True
   have "?lhs = (\<Sum>\<^sup>+ y'. f (x, y') + k * indicator {y} y') - (\<Sum>\<^sup>+ y'. f (x, y') * indicator {y} y')"
     unfolding d_OUT_def using assms True
     by(subst nn_integral_diff[symmetric])
       (auto intro!: nn_integral_cong simp add: AE_count_space split: split_indicator)
   also have "(\<Sum>\<^sup>+ y'. f (x, y') + k * indicator {y} y') = d_OUT f x + (\<Sum>\<^sup>+ y'. k * indicator {y} y')"
     unfolding d_OUT_def using assms
     by(subst nn_integral_add[symmetric])
       (auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> - (\<Sum>\<^sup>+ y'. f (x, y') * indicator {y} y') = ?rhs" using True assms
     by(subst diff_add_assoc2_ennreal[symmetric])(auto simp add: d_OUT_def intro!: nn_integral_ge_point)
   finally show ?thesis .
 qed(simp add: d_OUT_def)
 
 lemma unhindered_saturate1: \<comment> \<open>Lemma 6.10\<close>
   assumes unhindered: "\<not> hindered \<Gamma>"
   and a: "a \<in> A \<Gamma>"
   shows "\<exists>f. current \<Gamma> f \<and> d_OUT f a = weight \<Gamma> a \<and> \<not> hindered (\<Gamma> \<ominus> f)"
 proof -
   from a A_vertex have a_vertex: "vertex \<Gamma> a" by auto
   from unhindered have "\<not> hindrance \<Gamma> zero_current" by(auto intro!: hindered.intros simp add: )
   then have a_\<E>: "a \<in> \<E> (A \<Gamma>)" if "weight \<Gamma> a > 0"
   proof(rule contrapos_np)
     assume "a \<notin> \<E> (A \<Gamma>)"
     with a have "\<not> essential \<Gamma> (B \<Gamma>) (A \<Gamma>) a" by simp
     hence "\<not> essential \<Gamma> (B \<Gamma>) (A \<Gamma> \<union> {x. weight \<Gamma> x \<le> 0}) a"
       by(rule contrapos_nn)(erule essential_mono; simp)
     with a that show "hindrance \<Gamma> zero_current" by(auto intro: hindrance)
   qed
 
   define F where "F = (\<lambda>(\<epsilon>, h :: 'v current). plus_current \<epsilon> h)"
   have F_simps: "F (\<epsilon>, h) = plus_current \<epsilon> h" for \<epsilon> h by(simp add: F_def)
   define Fld where "Fld = {(\<epsilon>, h).
      current \<Gamma> \<epsilon> \<and> (\<forall>x. x \<noteq> a \<longrightarrow> d_OUT \<epsilon> x = 0) \<and>
      current (\<Gamma> \<ominus> \<epsilon>) h \<and> wave (\<Gamma> \<ominus> \<epsilon>) h \<and>
      \<not> hindered (\<Gamma> \<ominus> F (\<epsilon>, h))}"
   define leq where "leq = restrict_rel Fld {(f, f'). f \<le> f'}"
   have Fld: "Field leq = Fld" by(auto simp add: leq_def)
   have F_I [intro?]: "(\<epsilon>, h) \<in> Field leq"
     if "current \<Gamma> \<epsilon>" and "\<And>x. x \<noteq> a \<Longrightarrow> d_OUT \<epsilon> x = 0"
     and "current (\<Gamma> \<ominus> \<epsilon>) h" and "wave (\<Gamma> \<ominus> \<epsilon>) h"
     and "\<not> hindered (\<Gamma> \<ominus> F (\<epsilon>, h))"
     for \<epsilon> h using that by(simp add: Fld Fld_def)
   have \<epsilon>_curr: "current \<Gamma> \<epsilon>" if "(\<epsilon>, h) \<in> Field leq" for \<epsilon> h using that by(simp add: Fld Fld_def)
   have OUT_\<epsilon>: "\<And>x. x \<noteq> a \<Longrightarrow> d_OUT \<epsilon> x = 0" if "(\<epsilon>, h) \<in> Field leq" for \<epsilon> h using that by(simp add: Fld Fld_def)
   have h: "current (\<Gamma> \<ominus> \<epsilon>) h" if "(\<epsilon>, h) \<in> Field leq" for \<epsilon> h using that by(simp add: Fld Fld_def)
   have h_w: "wave (\<Gamma> \<ominus> \<epsilon>) h" if "(\<epsilon>, h) \<in> Field leq" for \<epsilon> h using that by(simp add: Fld Fld_def)
   have unhindered': "\<not> hindered (\<Gamma> \<ominus> F \<epsilon>h)" if "\<epsilon>h \<in> Field leq" for \<epsilon>h using that by(simp add: Fld Fld_def split: prod.split_asm)
   have f: "current \<Gamma> (F \<epsilon>h)" if "\<epsilon>h \<in> Field leq" for \<epsilon>h using \<epsilon>_curr h that
     by(cases \<epsilon>h)(simp add: F_simps current_plus_current_minus)
   have out_\<epsilon>: "\<epsilon> (x, y) = 0" if "(\<epsilon>, h) \<in> Field leq" "x \<noteq> a" for \<epsilon> h x y
   proof(rule antisym)
     have "\<epsilon> (x, y) \<le> d_OUT \<epsilon> x" unfolding d_OUT_def by(rule nn_integral_ge_point) simp
     with OUT_\<epsilon>[OF that] show "\<epsilon> (x, y) \<le> 0" by simp
   qed simp
   have IN_\<epsilon>: "d_IN \<epsilon> x = \<epsilon> (a, x)" if "(\<epsilon>, h) \<in> Field leq" for \<epsilon> h x
   proof(rule trans)
     show "d_IN \<epsilon> x = (\<Sum>\<^sup>+ y. \<epsilon> (y, x) * indicator {a} y)" unfolding d_IN_def
       by(rule nn_integral_cong)(simp add: out_\<epsilon>[OF that] split: split_indicator)
   qed(simp add: max_def \<epsilon>_curr[OF that])
   have leqI: "((\<epsilon>, h), (\<epsilon>', h')) \<in> leq" if "\<epsilon> \<le> \<epsilon>'" "h \<le> h'" "(\<epsilon>, h) \<in> Field leq" "(\<epsilon>', h') \<in> Field leq" for \<epsilon> h \<epsilon>' h'
     using that unfolding Fld by(simp add: leq_def in_restrict_rel_iff)
 
   have chain_Field: "Sup M \<in> Field leq" if M: "M \<in> Chains leq" and nempty: "M \<noteq> {}" for M
     unfolding Sup_prod_def
   proof
     from nempty obtain \<epsilon> h where in_M: "(\<epsilon>, h) \<in> M" by auto
     with M have Field: "(\<epsilon>, h) \<in> Field leq" by(rule Chains_FieldD)
 
     from M have chain: "Complete_Partial_Order.chain (\<lambda>\<epsilon> \<epsilon>'. (\<epsilon>, \<epsilon>') \<in> leq) M"
       by(intro Chains_into_chain) simp
     hence chain': "Complete_Partial_Order.chain (\<le>) M"
       by(auto simp add: chain_def leq_def in_restrict_rel_iff)
     hence chain1: "Complete_Partial_Order.chain (\<le>) (fst ` M)"
       and chain2: "Complete_Partial_Order.chain (\<le>) (snd ` M)"
       by(rule chain_imageI; auto)+
 
     have outside1: "Sup (fst ` M) (x, y) = 0" if "\<not> edge \<Gamma> x y" for x y using that
       by(auto intro!: SUP_eq_const simp add: nempty dest!: Chains_FieldD[OF M] \<epsilon>_curr currentD_outside)
     then have "support_flow (Sup (fst ` M)) \<subseteq> \<^bold>E" by(auto elim!: support_flow.cases intro: ccontr)
     hence supp_flow1: "countable (support_flow (Sup (fst ` M)))" by(rule countable_subset) simp
 
     show SM1: "current \<Gamma> (Sup (fst ` M))"
       by(rule current_Sup[OF chain1 _ _ supp_flow1])(auto dest: Chains_FieldD[OF M, THEN \<epsilon>_curr] simp add: nempty)
     show OUT1_na: "d_OUT (Sup (fst ` M)) x = 0" if "x \<noteq> a" for x using that
       by(subst d_OUT_Sup[OF chain1 _ supp_flow1])(auto simp add: nempty intro!: SUP_eq_const dest: Chains_FieldD[OF M, THEN OUT_\<epsilon>])
 
     interpret SM1: countable_bipartite_web "\<Gamma> \<ominus> Sup (fst ` M)"
       using SM1 by(rule countable_bipartite_web_minus_web)
 
     let ?h = "Sup (snd ` M)"
     have outside2: "?h (x, y) = 0" if "\<not> edge \<Gamma> x y" for x y using that
       by(auto intro!: SUP_eq_const simp add: nempty dest!: Chains_FieldD[OF M] h currentD_outside)
     then have "support_flow ?h \<subseteq> \<^bold>E" by(auto elim!: support_flow.cases intro: ccontr)
     hence supp_flow2: "countable (support_flow ?h)" by(rule countable_subset) simp
 
     have OUT1: "d_OUT (Sup (fst ` M)) x = (SUP (\<epsilon>, h)\<in>M. d_OUT \<epsilon> x)" for x
       by (subst d_OUT_Sup [OF chain1 _ supp_flow1])
         (simp_all add: nempty split_beta image_comp)
     have OUT1': "d_OUT (Sup (fst ` M)) x = (if x = a then SUP (\<epsilon>, h)\<in>M. d_OUT \<epsilon> a else 0)" for x
       unfolding OUT1 by(auto intro!: SUP_eq_const simp add: nempty OUT_\<epsilon> dest!: Chains_FieldD[OF M])
     have OUT1_le: "(\<Squnion>\<epsilon>h\<in>M. d_OUT (fst \<epsilon>h) x) \<le> weight \<Gamma> x" for x
       using currentD_weight_OUT[OF SM1, of x] OUT1[of x] by(simp add: split_beta)
     have OUT1_nonneg: "0 \<le> (\<Squnion>\<epsilon>h\<in>M. d_OUT (fst \<epsilon>h) x)" for x using in_M by(rule SUP_upper2)simp
     have IN1: "d_IN (Sup (fst ` M)) x = (SUP (\<epsilon>, h)\<in>M. d_IN \<epsilon> x)" for x
       by (subst d_IN_Sup [OF chain1 _ supp_flow1])
         (simp_all add: nempty split_beta image_comp)
     have IN1_le: "(\<Squnion>\<epsilon>h\<in>M. d_IN (fst \<epsilon>h) x) \<le> weight \<Gamma> x" for x
       using currentD_weight_IN[OF SM1, of x] IN1[of x] by(simp add: split_beta)
     have IN1_nonneg: "0 \<le> (\<Squnion>\<epsilon>h\<in>M. d_IN (fst \<epsilon>h) x)" for x using in_M by(rule SUP_upper2) simp
     have IN1': "d_IN (Sup (fst ` M)) x = (SUP (\<epsilon>, h)\<in>M. \<epsilon> (a, x))" for x
       unfolding IN1 by(rule SUP_cong[OF refl])(auto dest!: Chains_FieldD[OF M] IN_\<epsilon>)
 
     have directed: "\<exists>\<epsilon>k''\<in>M. F (snd \<epsilon>k) + F (fst \<epsilon>k') \<le> F (snd \<epsilon>k'') + F (fst \<epsilon>k'')"
       if mono: "\<And>f g. (\<And>z. f z \<le> g z) \<Longrightarrow> F f \<le> F g" "\<epsilon>k \<in> M" "\<epsilon>k' \<in> M"
       for \<epsilon>k \<epsilon>k' and F :: "_ \<Rightarrow> ennreal"
       using chainD[OF chain that(2-3)]
     proof cases
       case left
       hence "snd \<epsilon>k \<le> snd \<epsilon>k'" by(simp add: leq_def less_eq_prod_def in_restrict_rel_iff)
       hence "F (snd \<epsilon>k) + F (fst \<epsilon>k') \<le> F (snd \<epsilon>k') + F (fst \<epsilon>k')"
         by(intro add_right_mono mono)(clarsimp simp add: le_fun_def)
       with that show ?thesis by blast
     next
       case right
       hence "fst \<epsilon>k' \<le> fst \<epsilon>k" by(simp add: leq_def less_eq_prod_def in_restrict_rel_iff)
       hence "F (snd \<epsilon>k) + F (fst \<epsilon>k') \<le> F (snd \<epsilon>k) + F (fst \<epsilon>k)"
         by(intro add_left_mono mono)(clarsimp simp add: le_fun_def)
       with that show ?thesis by blast
     qed
     have directed_OUT: "\<exists>\<epsilon>k''\<in>M. d_OUT (snd \<epsilon>k) x + d_OUT (fst \<epsilon>k') x \<le> d_OUT (snd \<epsilon>k'') x + d_OUT (fst \<epsilon>k'') x"
       if "\<epsilon>k \<in> M" "\<epsilon>k' \<in> M" for x \<epsilon>k \<epsilon>k' by(rule directed; rule d_OUT_mono that)
     have directed_IN: "\<exists>\<epsilon>k''\<in>M. d_IN (snd \<epsilon>k) x + d_IN (fst \<epsilon>k') x \<le> d_IN (snd \<epsilon>k'') x + d_IN (fst \<epsilon>k'') x"
       if "\<epsilon>k \<in> M" "\<epsilon>k' \<in> M" for x \<epsilon>k \<epsilon>k' by(rule directed; rule d_IN_mono that)
 
     let ?\<Gamma> = "\<Gamma> \<ominus> Sup (fst ` M)"
 
     have hM2: "current ?\<Gamma> h" if \<epsilon>h: "(\<epsilon>, h) \<in> M" for \<epsilon> h
     proof
       from \<epsilon>h have Field: "(\<epsilon>, h) \<in> Field leq" by(rule Chains_FieldD[OF M])
       then have H: "current (\<Gamma> \<ominus> \<epsilon>) h" and \<epsilon>_curr': "current \<Gamma> \<epsilon>" by(rule h \<epsilon>_curr)+
       from \<epsilon>_curr' interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> \<epsilon>" by(rule countable_bipartite_web_minus_web)
 
       fix x
       have "d_OUT h x \<le> d_OUT ?h x" using \<epsilon>h by(intro d_OUT_mono)(auto intro: SUP_upper2)
       also have OUT: "\<dots> = (SUP h\<in>snd ` M. d_OUT h x)" using chain2 _ supp_flow2
         by(rule d_OUT_Sup)(simp_all add: nempty)
       also have "\<dots> = \<dots> + (SUP \<epsilon>\<in>fst ` M. d_OUT \<epsilon> x) - (SUP \<epsilon>\<in>fst ` M. d_OUT \<epsilon> x)"
         using OUT1_le[of x]
         by (intro ennreal_add_diff_cancel_right[symmetric] neq_top_trans[OF weight_finite, of _ x])
           (simp add: image_comp)
       also have "\<dots> = (SUP (\<epsilon>, k)\<in>M. d_OUT k x + d_OUT \<epsilon> x) - (SUP \<epsilon>\<in>fst ` M. d_OUT \<epsilon> x)" unfolding split_def
         by (subst SUP_add_directed_ennreal[OF directed_OUT])
           (simp_all add: image_comp)
       also have "(SUP (\<epsilon>, k)\<in>M. d_OUT k x + d_OUT \<epsilon> x) \<le> weight \<Gamma> x"
         apply(clarsimp dest!: Chains_FieldD[OF M] intro!: SUP_least)
         subgoal premises that for \<epsilon> h
           using currentD_weight_OUT[OF h[OF that], of x] currentD_weight_OUT[OF \<epsilon>_curr[OF that], of x]
              countable_bipartite_web_minus_web[OF \<epsilon>_curr, THEN countable_bipartite_web.currentD_OUT', OF that h[OF that], where x=x]
           by (auto simp add: ennreal_le_minus_iff split: if_split_asm)
         done
       also have "(SUP \<epsilon>\<in>fst ` M. d_OUT \<epsilon> x) = d_OUT (Sup (fst ` M)) x" using OUT1
         by (simp add: split_beta image_comp)
       finally show "d_OUT h x \<le> weight ?\<Gamma> x"
         using \<Gamma>.currentD_OUT'[OF h[OF Field], of x] currentD_weight_IN[OF SM1, of x] by(auto simp add: ennreal_minus_mono)
 
       have "d_IN h x \<le> d_IN ?h x" using \<epsilon>h by(intro d_IN_mono)(auto intro: SUP_upper2)
       also have IN: "\<dots> = (SUP h\<in>snd ` M. d_IN h x)" using chain2 _ supp_flow2
         by(rule d_IN_Sup)(simp_all add: nempty)
       also have "\<dots> = \<dots> + (SUP \<epsilon>\<in>fst ` M. d_IN \<epsilon> x) - (SUP \<epsilon>\<in>fst ` M. d_IN \<epsilon> x)"
         using IN1_le[of x]
         by (intro ennreal_add_diff_cancel_right [symmetric] neq_top_trans [OF weight_finite, of _ x])
           (simp add: image_comp)
       also have "\<dots> = (SUP (\<epsilon>, k)\<in>M. d_IN k x + d_IN \<epsilon> x) - (SUP \<epsilon>\<in>fst ` M. d_IN \<epsilon> x)" unfolding split_def
         by (subst SUP_add_directed_ennreal [OF directed_IN])
           (simp_all add: image_comp)
       also have "(SUP (\<epsilon>, k)\<in>M. d_IN k x + d_IN \<epsilon> x) \<le> weight \<Gamma> x"
         apply(clarsimp dest!: Chains_FieldD[OF M] intro!: SUP_least)
         subgoal premises that for \<epsilon> h
           using currentD_weight_OUT[OF h, OF that, where x=x] currentD_weight_IN[OF h, OF that, where x=x]
             countable_bipartite_web_minus_web[OF \<epsilon>_curr, THEN countable_bipartite_web.currentD_OUT', OF that h[OF that], where x=x]
             currentD_OUT'[OF \<epsilon>_curr, OF that, where x=x] currentD_IN[OF \<epsilon>_curr, OF that, of x] currentD_weight_IN[OF \<epsilon>_curr, OF that, where x=x]
           by (auto simp add: ennreal_le_minus_iff image_comp
                      split: if_split_asm intro: add_increasing2 order_trans [rotated])
         done
       also have "(SUP \<epsilon>\<in>fst ` M. d_IN \<epsilon> x) = d_IN (Sup (fst ` M)) x"
         using IN1 by (simp add: split_beta image_comp)
       finally show "d_IN h x \<le> weight ?\<Gamma> x"
         using currentD_IN[OF h[OF Field], of x] currentD_weight_OUT[OF SM1, of x]
         by(auto simp add: ennreal_minus_mono)
           (auto simp add: ennreal_le_minus_iff add_increasing2)
       show "h e = 0" if "e \<notin> \<^bold>E\<^bsub>?\<Gamma>\<^esub>" for e using currentD_outside'[OF H, of e] that by simp
     qed
 
     from nempty have "snd ` M \<noteq> {}" by simp
     from chain2 this _ supp_flow2 show current: "current ?\<Gamma> ?h"
       by(rule current_Sup)(clarify; rule hM2; simp)
 
     have wM: "wave ?\<Gamma> h" if "(\<epsilon>, h) \<in> M" for \<epsilon> h
     proof
       let ?\<Gamma>' = "\<Gamma> \<ominus> \<epsilon>"
       have subset: "TER\<^bsub>?\<Gamma>'\<^esub> h \<subseteq> TER\<^bsub>?\<Gamma>\<^esub> h"
         using currentD_OUT'[OF SM1] currentD_OUT'[OF \<epsilon>_curr[OF Chains_FieldD[OF M that]]] that
         by(auto 4 7 elim!: SAT.cases intro: SAT.intros elim!: order_trans[rotated] intro: ennreal_minus_mono d_IN_mono intro!: SUP_upper2 split: if_split_asm)
 
       from h_w[OF Chains_FieldD[OF M], OF that] have "separating ?\<Gamma>' (TER\<^bsub>?\<Gamma>'\<^esub> h)" by(rule waveD_separating)
       then show "separating ?\<Gamma> (TER\<^bsub>?\<Gamma>\<^esub> h)" using subset by(auto intro: separating_weakening)
     qed(rule hM2[OF that])
     show wave: "wave ?\<Gamma> ?h" using chain2 \<open>snd ` M \<noteq> {}\<close> _ supp_flow2
       by(rule wave_lub)(clarify; rule wM; simp)
 
     define f where "f = F (Sup (fst ` M), Sup (snd ` M))"
     have supp_flow: "countable (support_flow f)"
       using supp_flow1 supp_flow2 support_flow_plus_current[of "Sup (fst ` M)" ?h]
       unfolding f_def F_simps by(blast intro: countable_subset)
     have f_alt: "f = Sup ((\<lambda>(\<epsilon>, h). plus_current \<epsilon> h) ` M)"
       apply (simp add: fun_eq_iff split_def f_def nempty F_def image_comp)
       apply (subst (1 2) add.commute)
       apply (subst SUP_add_directed_ennreal)
       apply (rule directed)
       apply (auto dest!: Chains_FieldD [OF M])
       done
     have f_curr: "current \<Gamma> f" unfolding f_def F_simps using SM1 current by(rule current_plus_current_minus)
     have IN_f: "d_IN f x = d_IN (Sup (fst ` M)) x + d_IN (Sup (snd ` M)) x" for x
       unfolding f_def F_simps plus_current_def
       by(rule d_IN_add SM1 current)+
     have OUT_f: "d_OUT f x = d_OUT (Sup (fst ` M)) x + d_OUT (Sup (snd ` M)) x" for x
       unfolding f_def F_simps plus_current_def
       by(rule d_OUT_add SM1 current)+
 
     show "\<not> hindered (\<Gamma> \<ominus> f)" (is "\<not> hindered ?\<Omega>") \<comment> \<open>Assertion 6.11\<close>
     proof
       assume hindered: "hindered ?\<Omega>"
       then obtain g where g: "current ?\<Omega> g" and g_w: "wave ?\<Omega> g" and hindrance: "hindrance ?\<Omega> g" by cases
       from hindrance obtain z where z: "z \<in> A \<Gamma>" and z\<E>: "z \<notin> \<E>\<^bsub>?\<Omega>\<^esub> (TER\<^bsub>?\<Omega>\<^esub> g)"
         and OUT_z: "d_OUT g z < weight ?\<Omega> z" by cases auto
       define \<delta> where "\<delta> = weight ?\<Omega> z - d_OUT g z"
       have \<delta>_pos: "\<delta> > 0" using OUT_z by(simp add: \<delta>_def diff_gr0_ennreal del: minus_web_sel)
       then have \<delta>_finite[simp]: "\<delta> \<noteq> \<top>" using z
         by(simp_all add: \<delta>_def)
 
       have "\<exists>(\<epsilon>, h) \<in> M. d_OUT f a < d_OUT (plus_current \<epsilon> h) a + \<delta>"
       proof(rule ccontr)
         assume "\<not> ?thesis"
         hence greater: "d_OUT (plus_current \<epsilon> h) a + \<delta> \<le> d_OUT f a" if "(\<epsilon>, h) \<in> M" for \<epsilon> h using that by auto
 
         have chain'': "Complete_Partial_Order.chain (\<le>) ((\<lambda>(\<epsilon>, h). plus_current \<epsilon> h) ` M)"
           using chain' by(rule chain_imageI)(auto simp add: le_fun_def add_mono)
 
         have "d_OUT f a + 0 < d_OUT f a + \<delta>"
           using currentD_finite_OUT[OF f_curr, of a] by (simp add: \<delta>_pos)
         also have "d_OUT f a + \<delta> = (SUP (\<epsilon>, h)\<in>M. d_OUT (plus_current \<epsilon> h) a) + \<delta>"
           using chain'' nempty supp_flow
           unfolding f_alt by (subst d_OUT_Sup)
             (simp_all add: plus_current_def [abs_def] split_def image_comp)
         also have "\<dots> \<le> d_OUT f a"
           unfolding ennreal_SUP_add_left[symmetric, OF nempty]
         proof(rule SUP_least, clarify)
           show "d_OUT (plus_current \<epsilon> h) a + \<delta> \<le> d_OUT f a" if "(\<epsilon>, h) \<in> M" for \<epsilon> h
             using greater[OF that] currentD_finite_OUT[OF Chains_FieldD[OF M that, THEN f], of a]
             by(auto simp add: ennreal_le_minus_iff add.commute F_def)
         qed
         finally show False by simp
       qed
       then obtain \<epsilon> h where hM: "(\<epsilon>, h) \<in> M" and close: "d_OUT f a < d_OUT (plus_current \<epsilon> h) a + \<delta>" by blast
       have Field: "(\<epsilon>, h) \<in> Field leq" using hM by(rule Chains_FieldD[OF M])
       then have \<epsilon>: "current \<Gamma> \<epsilon>"
         and unhindered_h: "\<not> hindered (\<Gamma> \<ominus> F (\<epsilon>, h))"
         and h_curr: "current (\<Gamma> \<ominus> \<epsilon>) h"
         and h_w: "wave (\<Gamma> \<ominus> \<epsilon>) h"
         and OUT_\<epsilon>: "x \<noteq> a \<Longrightarrow> d_OUT \<epsilon> x = 0" for x
         by(rule \<epsilon>_curr OUT_\<epsilon> h h_w unhindered')+
       let ?\<epsilon>h = "plus_current \<epsilon> h"
       have \<epsilon>h_curr: "current \<Gamma> ?\<epsilon>h" using Field unfolding F_simps[symmetric] by(rule f)
 
       interpret h: countable_bipartite_web "\<Gamma> \<ominus> \<epsilon>" using \<epsilon> by(rule countable_bipartite_web_minus_web)
       interpret \<epsilon>h: countable_bipartite_web "\<Gamma> \<ominus> ?\<epsilon>h" using \<epsilon>h_curr by(rule countable_bipartite_web_minus_web)
       note [simp del] = minus_web_sel(2)
         and [simp] = weight_minus_web[OF \<epsilon>h_curr] weight_minus_web[OF SM1, simplified]
 
       define k where "k e = Sup (fst ` M) e - \<epsilon> e" for e
       have k_simps: "k (x, y) = Sup (fst ` M) (x, y) - \<epsilon> (x, y)" for x y by(simp add: k_def)
       have k_alt: "k (x, y) = (if x = a \<and> edge \<Gamma> x y then Sup (fst ` M) (a, y) - \<epsilon> (a, y) else 0)" for x y
         by (cases "x = a")
           (auto simp add: k_simps out_\<epsilon> [OF Field] currentD_outside [OF \<epsilon>] image_comp
            intro!: SUP_eq_const [OF nempty] dest!: Chains_FieldD [OF M]
            intro: currentD_outside [OF \<epsilon>_curr] out_\<epsilon>)
       have OUT_k: "d_OUT k x = (if x = a then d_OUT (Sup (fst ` M)) a - d_OUT \<epsilon> a else 0)" for x
       proof -
         have "d_OUT k x = (if x = a then (\<Sum>\<^sup>+ y. Sup (fst ` M) (a, y) - \<epsilon> (a, y)) else 0)"
           using currentD_outside[OF SM1] currentD_outside[OF \<epsilon>]
           by(auto simp add: k_alt d_OUT_def intro!: nn_integral_cong)
         also have "(\<Sum>\<^sup>+ y. Sup (fst ` M) (a, y) - \<epsilon> (a, y)) = d_OUT (Sup (fst `M)) a - d_OUT \<epsilon> a"
           using currentD_finite_OUT[OF \<epsilon>, of a] hM unfolding d_OUT_def
           by(subst nn_integral_diff[symmetric])(auto simp add: AE_count_space intro!: SUP_upper2)
         finally show ?thesis .
       qed
       have IN_k: "d_IN k y = (if edge \<Gamma> a y then Sup (fst ` M) (a, y) - \<epsilon> (a, y) else 0)" for y
       proof -
         have "d_IN k y = (\<Sum>\<^sup>+ x. (if edge \<Gamma> x y then Sup (fst ` M) (a, y) - \<epsilon> (a, y) else 0) * indicator {a} x)"
           unfolding d_IN_def by(rule nn_integral_cong)(auto simp add: k_alt outgoing_def split: split_indicator)
         also have "\<dots> = (if edge \<Gamma> a y then Sup (fst ` M) (a, y) - \<epsilon> (a, y) else 0)" using hM
           by(auto simp add: max_def intro!: SUP_upper2)
         finally show ?thesis .
       qed
 
       have OUT_\<epsilon>h: "d_OUT ?\<epsilon>h x = d_OUT \<epsilon> x + d_OUT h x" for x
         unfolding plus_current_def by(rule d_OUT_add)+
       have IN_\<epsilon>h: "d_IN ?\<epsilon>h x = d_IN \<epsilon> x + d_IN h x" for x
         unfolding plus_current_def by(rule d_IN_add)+
 
       have OUT1_le': "d_OUT (Sup (fst`M)) x \<le> weight \<Gamma> x" for x
         using OUT1_le[of x] unfolding OUT1 by (simp add: split_beta')
 
       have k: "current (\<Gamma> \<ominus> ?\<epsilon>h) k"
       proof
         fix x
         show "d_OUT k x \<le> weight (\<Gamma> \<ominus> ?\<epsilon>h) x"
           using a OUT1_na[of x] currentD_weight_OUT[OF hM2[OF hM], of x] currentD_weight_IN[OF \<epsilon>h_curr, of x]
             currentD_weight_IN[OF \<epsilon>, of x] OUT1_le'[of x]
           apply(auto simp add: diff_add_eq_diff_diff_swap_ennreal diff_add_assoc2_ennreal[symmetric]
                                OUT_k OUT_\<epsilon> OUT_\<epsilon>h IN_\<epsilon>h currentD_OUT'[OF \<epsilon>] IN_\<epsilon>[OF Field] h.currentD_OUT'[OF h_curr])
           apply(subst diff_diff_commute_ennreal)
           apply(intro ennreal_minus_mono)
           apply(auto simp add: ennreal_le_minus_iff ac_simps less_imp_le OUT1)
           done
 
         have *: "(\<Squnion>xa\<in>M. fst xa (a, x)) \<le> d_IN (Sup (fst`M)) x"
           unfolding IN1 by (intro SUP_subset_mono) (auto simp: split_beta' d_IN_ge_point)
         also have "\<dots> \<le> weight \<Gamma> x"
           using IN1_le[of x] IN1 by (simp add: split_beta')
         finally show "d_IN k x \<le> weight (\<Gamma> \<ominus> ?\<epsilon>h) x"
           using currentD_weight_IN[OF \<epsilon>h_curr, of x] currentD_weight_OUT[OF \<epsilon>h_curr, of x]
             currentD_weight_IN[OF hM2[OF hM], of x] IN_\<epsilon>[OF Field, of x] *
           apply (auto simp add: IN_k outgoing_def IN_\<epsilon>h IN_\<epsilon> A_in diff_add_eq_diff_diff_swap_ennreal)
           apply (subst diff_diff_commute_ennreal)
           apply (intro ennreal_minus_mono[OF _ order_refl])
           apply (auto simp add: ennreal_le_minus_iff ac_simps image_comp intro: order_trans add_mono)
           done
         show "k e = 0" if "e \<notin> \<^bold>E\<^bsub>\<Gamma> \<ominus> ?\<epsilon>h\<^esub>" for e
           using that by (cases e) (simp add: k_alt)
       qed
 
       define q where "q = (\<Sum>\<^sup>+ y\<in>B (\<Gamma> \<ominus> ?\<epsilon>h). d_IN k y - d_OUT k y)"
       have q_alt: "q = (\<Sum>\<^sup>+ y\<in>- A (\<Gamma> \<ominus> ?\<epsilon>h). d_IN k y - d_OUT k y)" using disjoint
         by(auto simp add: q_def nn_integral_count_space_indicator currentD_outside_OUT[OF k] currentD_outside_IN[OF k] not_vertex split: split_indicator intro!: nn_integral_cong)
       have q_simps: "q = d_OUT (Sup (fst ` M)) a - d_OUT \<epsilon> a"
       proof -
         have "q = (\<Sum>\<^sup>+ y. d_IN k y)" using a IN1 OUT1 OUT1_na unfolding q_alt
           by(auto simp add: nn_integral_count_space_indicator OUT_k IN_\<epsilon>[OF Field] OUT_\<epsilon> currentD_outside[OF \<epsilon>] outgoing_def no_loop A_in IN_k intro!: nn_integral_cong split: split_indicator)
         also have "\<dots> = d_OUT (Sup (fst ` M)) a - d_OUT \<epsilon> a" using currentD_finite_OUT[OF \<epsilon>, of a] hM currentD_outside[OF SM1] currentD_outside[OF \<epsilon>]
           by(subst d_OUT_diff[symmetric])(auto simp add: d_OUT_def IN_k intro!: SUP_upper2 nn_integral_cong)
         finally show ?thesis .
       qed
       have q_finite: "q \<noteq> \<top>" using currentD_finite_OUT[OF SM1, of a]
         by(simp add: q_simps)
       have q_nonneg: "0 \<le> q" using hM by(auto simp add: q_simps intro!: d_OUT_mono SUP_upper2)
       have q_less_\<delta>: "q < \<delta>" using close
         unfolding q_simps \<delta>_def OUT_\<epsilon>h OUT_f
       proof -
         let ?F = "d_OUT (Sup (fst`M)) a" and ?S = "d_OUT (Sup (snd`M)) a"
           and ?\<epsilon> = "d_OUT \<epsilon> a" and ?h = "d_OUT h a" and ?w = "weight (\<Gamma> \<ominus> f) z - d_OUT g z"
         have "?F + ?h \<le> ?F + ?S"
           using hM by (auto intro!: add_mono d_OUT_mono SUP_upper2)
         also assume "?F + ?S < ?\<epsilon> + ?h + ?w"
         finally have "?h + ?F < ?h + (?w + ?\<epsilon>)"
           by (simp add: ac_simps)
         then show "?F - ?\<epsilon> < ?w"
           using currentD_finite_OUT[OF \<epsilon>, of a] hM unfolding ennreal_add_left_cancel_less
           by (subst minus_less_iff_ennreal) (auto intro!: d_OUT_mono SUP_upper2 simp: less_top)
       qed
 
       define g' where "g' = plus_current g (Sup (snd ` M) - h)"
       have g'_simps: "g' e = g e + Sup (snd ` M) e - h e" for e
         using hM by(auto simp add: g'_def intro!: add_diff_eq_ennreal intro: SUP_upper2)
       have OUT_g': "d_OUT g' x = d_OUT g x + (d_OUT (Sup (snd ` M)) x - d_OUT h x)" for x
         unfolding g'_simps[abs_def] using \<epsilon>h.currentD_finite_OUT[OF k] hM h.currentD_finite_OUT[OF h_curr] hM
         apply(subst d_OUT_diff)
          apply(auto simp add: add_diff_eq_ennreal[symmetric] k_simps intro: add_increasing intro!: SUP_upper2)
         apply(subst d_OUT_add)
          apply(auto simp add: add_diff_eq_ennreal[symmetric] k_simps intro: add_increasing intro!:)
         apply(simp add: add_diff_eq_ennreal SUP_apply[abs_def])
         apply(auto simp add: g'_def image_comp intro!: add_diff_eq_ennreal[symmetric] d_OUT_mono intro: SUP_upper2)
         done
       have IN_g': "d_IN g' x = d_IN g x + (d_IN (Sup (snd ` M)) x - d_IN h x)" for x
         unfolding g'_simps[abs_def] using \<epsilon>h.currentD_finite_IN[OF k] hM h.currentD_finite_IN[OF h_curr] hM
         apply(subst d_IN_diff)
          apply(auto simp add: add_diff_eq_ennreal[symmetric] k_simps intro: add_increasing intro!: SUP_upper2)
         apply(subst d_IN_add)
          apply(auto simp add: add_diff_eq_ennreal[symmetric] k_simps intro: add_increasing intro!: SUP_upper)
         apply(auto simp add: g'_def SUP_apply[abs_def] image_comp intro!: add_diff_eq_ennreal[symmetric] d_IN_mono intro: SUP_upper2)
         done
 
       have h': "current (\<Gamma> \<ominus> Sup (fst ` M)) h" using hM by(rule hM2)
 
       let ?\<Gamma> = "\<Gamma> \<ominus> ?\<epsilon>h \<ominus> k"
       interpret \<Gamma>: web ?\<Gamma> using k by(rule \<epsilon>h.web_minus_web)
       note [simp] = \<epsilon>h.weight_minus_web[OF k] h.weight_minus_web[OF h_curr]
         weight_minus_web[OF f_curr] SM1.weight_minus_web[OF h', simplified]
 
       interpret \<Omega>: countable_bipartite_web "\<Gamma> \<ominus> f" using f_curr by(rule countable_bipartite_web_minus_web)
 
       have *: "\<Gamma> \<ominus> f = \<Gamma> \<ominus> Sup (fst ` M) \<ominus> Sup (snd ` M)" unfolding f_def F_simps
         using SM1 current by(rule minus_plus_current)
       have OUT_\<epsilon>k: "d_OUT (Sup (fst ` M)) x = d_OUT \<epsilon> x + d_OUT k x" for x
         using OUT1'[of x] currentD_finite_OUT[OF \<epsilon>] hM
         by(auto simp add: OUT_k OUT_\<epsilon> add_diff_self_ennreal SUP_upper2)
       have IN_\<epsilon>k: "d_IN (Sup (fst ` M)) x = d_IN \<epsilon> x + d_IN k x" for x
         using IN1'[of x] currentD_finite_IN[OF \<epsilon>] currentD_outside[OF \<epsilon>] currentD_outside[OF \<epsilon>_curr]
         by(auto simp add: IN_k IN_\<epsilon>[OF Field] add_diff_self_ennreal split_beta nempty image_comp
                 dest!: Chains_FieldD[OF M] intro!: SUP_eq_const intro: SUP_upper2[OF hM])
       have **: "?\<Gamma> = \<Gamma> \<ominus> Sup (fst ` M) \<ominus> h"
       proof(rule web.equality)
         show "weight ?\<Gamma> = weight (\<Gamma> \<ominus> Sup (fst ` M) \<ominus> h)"
           using OUT_\<epsilon>k OUT_\<epsilon>h currentD_finite_OUT[OF \<epsilon>] IN_\<epsilon>k IN_\<epsilon>h currentD_finite_IN[OF \<epsilon>]
           by(auto simp add: diff_add_eq_diff_diff_swap_ennreal diff_diff_commute_ennreal)
       qed simp_all
       have g'_alt: "g' = plus_current (Sup (snd ` M)) g - h"
         by(simp add: fun_eq_iff g'_simps add_diff_eq_ennreal add.commute)
 
       have "current (\<Gamma> \<ominus> Sup (fst ` M)) (plus_current (Sup (snd ` M)) g)" using current g unfolding *
         by(rule SM1.current_plus_current_minus)
       hence g': "current ?\<Gamma> g'" unfolding * ** g'_alt using hM2[OF hM]
         by(rule SM1.current_minus)(auto intro!: add_increasing2 SUP_upper2 hM)
 
       have "wave (\<Gamma> \<ominus> Sup (fst ` M)) (plus_current (Sup (snd ` M)) g)" using current wave g g_w
         unfolding * by(rule SM1.wave_plus_current_minus)
       then have g'_w: "wave ?\<Gamma> g'" unfolding * ** g'_alt using hM2[OF hM]
         by(rule SM1.wave_minus)(auto intro!: add_increasing2 SUP_upper2 hM)
 
       have "hindrance_by ?\<Gamma> g' q"
       proof
         show "z \<in> A ?\<Gamma>" using z by simp
         show "z \<notin> \<E>\<^bsub>?\<Gamma>\<^esub> (TER\<^bsub>?\<Gamma>\<^esub> g')"
         proof
           assume "z \<in> \<E>\<^bsub>?\<Gamma>\<^esub> (TER\<^bsub>?\<Gamma>\<^esub> g')"
           hence OUT_z: "d_OUT g' z = 0"
             and ess: "essential ?\<Gamma> (B \<Gamma>) (TER\<^bsub>?\<Gamma>\<^esub> g') z" by(simp_all add: SINK.simps)
           from ess obtain p y where p: "path \<Gamma> z p y" and y: "y \<in> B \<Gamma>"
             and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER\<^bsub>?\<Gamma>\<^esub> g')" by(rule essentialE_RF) auto
           from y have y': "y \<notin> A \<Gamma>" using disjoint by blast
           from p z y obtain py: "p = [y]" and edge: "edge \<Gamma> z y" using disjoint
             by(cases)(auto 4 3 elim: rtrancl_path.cases dest: bipartite_E)
           hence yRF: "y \<notin> RF (TER\<^bsub>?\<Gamma>\<^esub> g')" using bypass[of y] by(auto)
           with wave_not_RF_IN_zero[OF g' g'_w, of y] have IN_g'_y: "d_IN g' y = 0"
             by(auto intro: roofed_greaterI)
           with yRF y y' have w_y: "weight ?\<Gamma> y > 0" using currentD_OUT[OF g', of y]
             by(auto simp add: RF_in_B currentD_SAT[OF g'] SINK.simps zero_less_iff_neq_zero)
           have "y \<notin> SAT (\<Gamma> \<ominus> f) g"
           proof
             assume "y \<in> SAT (\<Gamma> \<ominus> f) g"
             with y disjoint have IN_g_y: "d_IN g y = weight (\<Gamma> \<ominus> f) y" by(auto simp add: currentD_SAT[OF g])
             have "0 < weight \<Gamma> y - d_IN (\<Squnion>x\<in>M. fst x) y - d_IN h y"
               using y' w_y unfolding ** by auto
             have "d_IN g' y > 0"
               using y' w_y hM unfolding **
               apply(simp add: IN_g' IN_f IN_g_y diff_add_eq_diff_diff_swap_ennreal)
               apply(subst add_diff_eq_ennreal)
               apply(auto intro!: SUP_upper2 d_IN_mono simp: diff_add_self_ennreal diff_gt_0_iff_gt_ennreal)
               done
             with IN_g'_y show False by simp
           qed
           then have "y \<notin> TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g" by simp
           with p y py have "essential \<Gamma> (B \<Gamma>) (TER\<^bsub>\<Gamma> \<ominus> f\<^esub> g) z" by(auto intro: essentialI)
           moreover with z waveD_separating[OF g_w, THEN separating_RF_A] have "z \<in> \<E>\<^bsub>?\<Omega>\<^esub> (TER\<^bsub>?\<Omega>\<^esub> g)"
             by(auto simp add: RF_in_essential)
           with z\<E> show False by contradiction
         qed
         have "\<delta> \<le> weight ?\<Gamma> z - d_OUT g' z"
           unfolding ** OUT_g' using z
           apply (simp add: \<delta>_def OUT_f diff_add_eq_diff_diff_swap_ennreal)
           apply (subst (5) diff_diff_commute_ennreal)
           apply (rule ennreal_minus_mono[OF _ order_refl])
           apply (auto simp add: ac_simps diff_add_eq_diff_diff_swap_ennreal[symmetric] add_diff_self_ennreal image_comp
                       intro!: ennreal_minus_mono[OF order_refl] SUP_upper2[OF hM] d_OUT_mono)
           done
         then show q_z: "q < weight ?\<Gamma> z - d_OUT g' z" using q_less_\<delta> by simp
         then show "d_OUT g' z < weight ?\<Gamma> z" using q_nonneg z
           by(auto simp add: less_diff_eq_ennreal less_top[symmetric] ac_simps \<Gamma>.currentD_finite_OUT[OF g']
                   intro: le_less_trans[rotated] add_increasing)
       qed
       then have hindered_by: "hindered_by (\<Gamma> \<ominus> ?\<epsilon>h \<ominus> k) q" using g' g'_w by(rule hindered_by.intros)
       then have "hindered (\<Gamma> \<ominus> ?\<epsilon>h)" using q_finite unfolding q_def by -(rule \<epsilon>h.hindered_reduce_current[OF k])
       with unhindered_h show False unfolding F_simps by contradiction
     qed
   qed
 
   define sat where "sat =
     (\<lambda>(\<epsilon>, h).
       let
         f = F (\<epsilon>, h);
         k = SOME k. current (\<Gamma> \<ominus> f) k \<and> wave (\<Gamma> \<ominus> f) k \<and> (\<forall>k'. current (\<Gamma> \<ominus> f) k' \<and> wave (\<Gamma> \<ominus> f) k' \<and> k \<le> k' \<longrightarrow> k = k')
       in
         if d_OUT (plus_current f k) a < weight \<Gamma> a then
           let
             \<Omega> = \<Gamma> \<ominus> f \<ominus> k;
             y = SOME y. y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Omega>\<^esub> a \<and> weight \<Omega> y > 0;
             \<delta> = SOME \<delta>. \<delta> > 0 \<and> \<delta> < enn2real (min (weight \<Omega> a) (weight \<Omega> y)) \<and> \<not> hindered (reduce_weight \<Omega> y \<delta>)
           in
             (plus_current \<epsilon> (zero_current((a, y) := \<delta>)), plus_current h k)
         else (\<epsilon>, h))"
 
   have zero: "(zero_current, zero_current) \<in> Field leq"
     by(rule F_I)(simp_all add: unhindered  F_def)
 
   have a_TER: "a \<in> TER\<^bsub>\<Gamma> \<ominus> F \<epsilon>h\<^esub> k"
     if that: "\<epsilon>h \<in> Field leq"
     and k: "current (\<Gamma> \<ominus> F \<epsilon>h) k" and k_w: "wave (\<Gamma> \<ominus> F \<epsilon>h) k"
     and less: "d_OUT (plus_current (F \<epsilon>h) k) a < weight \<Gamma> a" for \<epsilon>h k
   proof(rule ccontr)
     assume "\<not> ?thesis"
     hence \<E>: "a \<notin> \<E>\<^bsub>\<Gamma> \<ominus> F \<epsilon>h\<^esub> (TER\<^bsub>\<Gamma> \<ominus> F \<epsilon>h\<^esub> k)" by auto
     from that have f: "current \<Gamma> (F \<epsilon>h)" and unhindered: "\<not> hindered (\<Gamma> \<ominus> F \<epsilon>h)"
        by(cases \<epsilon>h; simp add: f unhindered'; fail)+
 
     from less have "d_OUT k a < weight (\<Gamma> \<ominus> F \<epsilon>h) a" using a currentD_finite_OUT[OF f, of a]
       by(simp add: d_OUT_def nn_integral_add less_diff_eq_ennreal add.commute less_top[symmetric])
     with _ \<E> have "hindrance (\<Gamma> \<ominus> F \<epsilon>h) k" by(rule hindrance)(simp add: a)
     then have "hindered (\<Gamma> \<ominus> F \<epsilon>h)" using k k_w ..
     with unhindered show False by contradiction
   qed
 
   note minus_web_sel(2)[simp del]
 
   let ?P_y = "\<lambda>\<epsilon>h k y. y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Gamma> \<ominus> F \<epsilon>h \<ominus> k\<^esub> a \<and> weight (\<Gamma> \<ominus> F \<epsilon>h \<ominus> k) y > 0"
   have Ex_y: "Ex (?P_y \<epsilon>h k)"
     if that: "\<epsilon>h \<in> Field leq"
     and k: "current (\<Gamma> \<ominus> F \<epsilon>h) k" and k_w: "wave (\<Gamma> \<ominus> F \<epsilon>h) k"
     and less: "d_OUT (plus_current (F \<epsilon>h) k) a < weight \<Gamma> a" for \<epsilon>h k
   proof(rule ccontr)
     let ?\<Omega> = "\<Gamma> \<ominus> F \<epsilon>h \<ominus> k"
     assume *: "\<not> ?thesis"
 
     interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> F \<epsilon>h" using f[OF that] by(rule countable_bipartite_web_minus_web)
     note [simp] = weight_minus_web[OF f[OF that]] \<Gamma>.weight_minus_web[OF k]
 
     have "hindrance ?\<Omega> zero_current"
     proof
       show "a \<in> A ?\<Omega>" using a by simp
       show "a \<notin> \<E>\<^bsub>?\<Omega>\<^esub> (TER\<^bsub>?\<Omega>\<^esub> zero_current)" (is "a \<notin> \<E>\<^bsub>_\<^esub> ?TER")
       proof
         assume "a \<in> \<E>\<^bsub>?\<Omega>\<^esub> ?TER"
         then obtain p y where p: "path ?\<Omega> a p y" and y: "y \<in> B ?\<Omega>"
           and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF\<^bsub>?\<Omega>\<^esub> ?TER" by(rule \<E>_E_RF)(auto)
         from a p y disjoint have Nil: "p \<noteq> []" by(auto simp add: rtrancl_path_simps)
         hence "edge ?\<Omega> a (p ! 0)" "p ! 0 \<notin> RF\<^bsub>?\<Omega>\<^esub> ?TER"
           using rtrancl_path_nth[OF p, of 0] bypass by auto
         with * show False by(auto simp add: not_less outgoing_def intro: roofed_greaterI)
       qed
 
       have "d_OUT (plus_current (F \<epsilon>h) k) x = d_OUT (F \<epsilon>h) x + d_OUT k x" for x
         by(simp add: d_OUT_def nn_integral_add)
       then show "d_OUT zero_current a < weight ?\<Omega> a" using less a_TER[OF that k k_w less] a
         by(simp add: SINK.simps diff_gr0_ennreal)
     qed
     hence "hindered ?\<Omega>"
       by(auto intro!: hindered.intros order_trans[OF currentD_weight_OUT[OF k]] order_trans[OF currentD_weight_IN[OF k]])
     moreover have "\<not> hindered ?\<Omega>" using unhindered'[OF that] k k_w by(rule \<Gamma>.unhindered_minus_web)
     ultimately show False by contradiction
   qed
 
   have increasing: "\<epsilon>h \<le> sat \<epsilon>h \<and> sat \<epsilon>h \<in> Field leq" if "\<epsilon>h \<in> Field leq" for \<epsilon>h
   proof(cases \<epsilon>h)
     case (Pair \<epsilon> h)
     with that have that: "(\<epsilon>, h) \<in> Field leq" by simp
     have f: "current \<Gamma> (F (\<epsilon>, h))" and unhindered: "\<not> hindered (\<Gamma> \<ominus> F (\<epsilon>, h))"
       and \<epsilon>: "current \<Gamma> \<epsilon>"
       and h: "current (\<Gamma> \<ominus> \<epsilon>) h" and h_w: "wave (\<Gamma> \<ominus> \<epsilon>) h" and OUT_\<epsilon>: "x \<noteq> a \<Longrightarrow> d_OUT \<epsilon> x = 0" for x
       using that by(rule f unhindered' \<epsilon>_curr OUT_\<epsilon> h h_w)+
     interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> F (\<epsilon>, h)" using f by(rule countable_bipartite_web_minus_web)
     note [simp] = weight_minus_web[OF f]
 
     let ?P_k = "\<lambda>k. current (\<Gamma> \<ominus> F (\<epsilon>, h)) k \<and> wave (\<Gamma> \<ominus> F (\<epsilon>, h)) k \<and> (\<forall>k'. current (\<Gamma> \<ominus> F (\<epsilon>, h)) k' \<and> wave (\<Gamma> \<ominus> F (\<epsilon>, h)) k' \<and> k \<le> k' \<longrightarrow> k = k')"
     define k where "k = Eps ?P_k"
     have "Ex ?P_k" by(intro ex_maximal_wave)(simp_all)
     hence "?P_k k" unfolding k_def by(rule someI_ex)
     hence k: "current (\<Gamma> \<ominus> F (\<epsilon>, h)) k" and k_w: "wave (\<Gamma> \<ominus> F (\<epsilon>, h)) k"
       and maximal: "\<And>k'. \<lbrakk> current (\<Gamma> \<ominus> F (\<epsilon>, h)) k'; wave (\<Gamma> \<ominus> F (\<epsilon>, h)) k'; k \<le> k' \<rbrakk> \<Longrightarrow> k = k'" by blast+
     note [simp] = \<Gamma>.weight_minus_web[OF k]
 
     let ?fk = "plus_current (F (\<epsilon>, h)) k"
     have IN_fk: "d_IN ?fk x = d_IN (F (\<epsilon>, h)) x + d_IN k x" for x
       by(simp add: d_IN_def nn_integral_add)
     have OUT_fk: "d_OUT ?fk x = d_OUT (F (\<epsilon>, h)) x + d_OUT k x" for x
       by(simp add: d_OUT_def nn_integral_add)
     have fk: "current \<Gamma> ?fk" using f k by(rule current_plus_current_minus)
 
     show ?thesis
     proof(cases "d_OUT ?fk a < weight \<Gamma> a")
       case less: True
 
       define \<Omega> where "\<Omega> = \<Gamma> \<ominus> F (\<epsilon>, h) \<ominus> k"
       have B_\<Omega> [simp]: "B \<Omega> = B \<Gamma>" by(simp add: \<Omega>_def)
 
       have loose: "loose \<Omega>" unfolding \<Omega>_def using unhindered k k_w maximal by(rule \<Gamma>.loose_minus_web)
       interpret \<Omega>: countable_bipartite_web \<Omega> using k unfolding \<Omega>_def
         by(rule \<Gamma>.countable_bipartite_web_minus_web)
 
       have a_\<E>: "a \<in> TER\<^bsub>\<Gamma> \<ominus> F (\<epsilon>, h)\<^esub> k" using that k k_w less by(rule a_TER)
       then have weight_\<Omega>_a: "weight \<Omega> a = weight \<Gamma> a - d_OUT (F (\<epsilon>, h)) a"
         using a disjoint by(auto simp add: roofed_circ_def \<Omega>_def SINK.simps)
       then have weight_a: "0 < weight \<Omega> a" using less a_\<E>
         by(simp add: OUT_fk SINK.simps diff_gr0_ennreal)
 
       let ?P_y = "\<lambda>y. y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Omega>\<^esub> a \<and> weight \<Omega> y > 0"
       define y where "y = Eps ?P_y"
       have "Ex ?P_y" using that k k_w less unfolding \<Omega>_def by(rule Ex_y)
       hence "?P_y y" unfolding y_def by(rule someI_ex)
       hence y_OUT: "y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Omega>\<^esub> a" and weight_y: "weight \<Omega> y > 0" by blast+
       from y_OUT have y_B: "y \<in> B \<Omega>" by(auto simp add: outgoing_def \<Omega>_def dest: bipartite_E)
       with weight_y have yRF: "y \<notin> RF\<^bsub>\<Gamma> \<ominus> F (\<epsilon>, h)\<^esub> (TER\<^bsub>\<Gamma> \<ominus> F (\<epsilon>, h)\<^esub> k)"
         unfolding \<Omega>_def using currentD_OUT[OF k, of y] disjoint
         by(auto split: if_split_asm simp add: SINK.simps currentD_SAT[OF k] roofed_circ_def RF_in_B \<Gamma>.currentD_finite_IN[OF k])
       hence IN_k_y: "d_IN k y = 0" by(rule wave_not_RF_IN_zero[OF k k_w])
 
       define bound where "bound = enn2real (min (weight \<Omega> a) (weight \<Omega> y))"
       have bound_pos: "bound > 0" using weight_y weight_a using \<Omega>.weight_finite
         by(cases "weight \<Omega> a" "weight \<Omega> y" rule: ennreal2_cases)
           (simp_all add: bound_def min_def split: if_split_asm)
 
       let ?P_\<delta> = "\<lambda>\<delta>. \<delta> > 0 \<and> \<delta> < bound \<and> \<not> hindered (reduce_weight \<Omega> y \<delta>)"
       define \<delta> where "\<delta> = Eps ?P_\<delta>"
       let ?\<Omega> = "reduce_weight \<Omega> y \<delta>"
 
       from \<Omega>.unhinder[OF loose _ weight_y bound_pos] y_B disjoint
       have "Ex ?P_\<delta>" by(auto simp add: \<Omega>_def)
       hence "?P_\<delta> \<delta>" unfolding \<delta>_def by(rule someI_ex)
       hence \<delta>_pos: "0 < \<delta>" and \<delta>_le_bound: "\<delta> < bound" and unhindered': "\<not> hindered ?\<Omega>" by blast+
       from \<delta>_pos have \<delta>_nonneg: "0 \<le> \<delta>" by simp
       from \<delta>_le_bound \<delta>_pos have \<delta>_le_a: "\<delta> < weight \<Omega> a" and \<delta>_le_y: "\<delta> < weight \<Omega> y"
         by(cases "weight \<Omega> a" "weight \<Omega> y" rule: ennreal2_cases;
            simp add: bound_def min_def ennreal_less_iff split: if_split_asm)+
 
       let ?\<Gamma> = "\<Gamma> \<ominus> ?fk"
       interpret \<Gamma>': countable_bipartite_web ?\<Gamma> by(rule countable_bipartite_web_minus_web fk)+
       note [simp] = weight_minus_web[OF fk]
 
       let ?g = "zero_current((a, y) := \<delta>)"
       have OUT_g: "d_OUT ?g x = (if x = a then \<delta> else 0)" for x
       proof(rule trans)
         show "d_OUT ?g x = (\<Sum>\<^sup>+ z. (if x = a then \<delta> else 0) * indicator {y} z)" unfolding d_OUT_def
           by(rule nn_integral_cong) simp
         show "\<dots> = (if x = a then \<delta> else 0)" using \<delta>_pos by(simp add: max_def)
       qed
       have IN_g: "d_IN ?g x = (if x = y then \<delta> else 0)" for x
       proof(rule trans)
         show "d_IN ?g x = (\<Sum>\<^sup>+ z. (if x = y then \<delta> else 0) * indicator {a} z)" unfolding d_IN_def
           by(rule nn_integral_cong) simp
         show "\<dots> = (if x = y then \<delta> else 0)" using \<delta>_pos by(simp add: max_def)
       qed
 
       have g: "current ?\<Gamma> ?g"
       proof
         show "d_OUT ?g x \<le> weight ?\<Gamma> x" for x
         proof(cases "x = a")
           case False
           then show ?thesis using currentD_weight_OUT[OF fk, of x] currentD_weight_IN[OF fk, of x]
             by(auto simp add: OUT_g zero_ennreal_def[symmetric])
         next
           case True
           then show ?thesis using \<delta>_le_a a a_\<E> \<delta>_pos unfolding OUT_g
             by(simp add: OUT_g \<Omega>_def SINK.simps OUT_fk split: if_split_asm)
         qed
         show "d_IN ?g x \<le> weight ?\<Gamma> x" for x
         proof(cases "x = y")
           case False
           then show ?thesis using currentD_weight_OUT[OF fk, of x] currentD_weight_IN[OF fk, of x]
             by(auto simp add: IN_g zero_ennreal_def[symmetric])
         next
           case True
           then show ?thesis using \<delta>_le_y y_B a_\<E> \<delta>_pos currentD_OUT[OF k, of y] IN_k_y
             by(simp add: OUT_g \<Omega>_def SINK.simps OUT_fk IN_fk IN_g split: if_split_asm)
         qed
         show "?g e = 0" if "e \<notin> \<^bold>E\<^bsub>?\<Gamma>\<^esub>" for e using y_OUT that by(auto simp add: \<Omega>_def outgoing_def)
       qed
       interpret \<Gamma>'': web "\<Gamma> \<ominus> ?fk \<ominus> ?g" using g by(rule \<Gamma>'.web_minus_web)
 
       let ?\<epsilon>' = "plus_current \<epsilon> (zero_current((a, y) := \<delta>))"
       let ?h' = "plus_current h k"
       have F': "F (?\<epsilon>', ?h') = plus_current (plus_current (F (\<epsilon>, h)) k) (zero_current((a, y) := \<delta>))" (is "_ = ?f'")
         by(auto simp add: F_simps fun_eq_iff add_ac)
       have sat: "sat (\<epsilon>, h) = (?\<epsilon>', ?h')" using less
         by(simp add: sat_def k_def \<Omega>_def Let_def y_def bound_def \<delta>_def)
 
       have le: "(\<epsilon>, h) \<le> (?\<epsilon>', ?h')" using \<delta>_pos
         by(auto simp add: le_fun_def add_increasing2 add_increasing)
 
       have "current (\<Gamma> \<ominus> \<epsilon>) ((\<lambda>_. 0)((a, y) := ennreal \<delta>))" using g
         by(rule current_weight_mono)(auto simp add: weight_minus_web[OF \<epsilon>] intro!: ennreal_minus_mono d_OUT_mono d_IN_mono, simp_all add: F_def add_increasing2)
       with \<epsilon> have \<epsilon>': "current \<Gamma> ?\<epsilon>'" by(rule current_plus_current_minus)
       moreover have eq_0: "d_OUT ?\<epsilon>' x = 0" if "x \<noteq> a" for x unfolding plus_current_def using that
         by(subst d_OUT_add)(simp_all add: \<delta>_nonneg d_OUT_fun_upd OUT_\<epsilon>)
       moreover
       from \<epsilon>' interpret \<epsilon>': countable_bipartite_web "\<Gamma> \<ominus> ?\<epsilon>'" by(rule countable_bipartite_web_minus_web)
       from \<epsilon> interpret \<epsilon>: countable_bipartite_web "\<Gamma> \<ominus> \<epsilon>" by(rule countable_bipartite_web_minus_web)
       have g': "current (\<Gamma> \<ominus> \<epsilon>) ?g" using g
         apply(rule current_weight_mono)
         apply(auto simp add: weight_minus_web[OF \<epsilon>] intro!: ennreal_minus_mono d_OUT_mono d_IN_mono)
         apply(simp_all add: F_def add_increasing2)
         done
       have k': "current (\<Gamma> \<ominus> \<epsilon> \<ominus> h) k" using k unfolding F_simps minus_plus_current[OF \<epsilon> h] .
       with h have "current (\<Gamma> \<ominus> \<epsilon>) (plus_current h k)" by(rule \<epsilon>.current_plus_current_minus)
       hence "current (\<Gamma> \<ominus> \<epsilon>) (plus_current (plus_current h k) ?g)" using g unfolding minus_plus_current[OF f k]
         unfolding F_simps minus_plus_current[OF \<epsilon> h] \<epsilon>.minus_plus_current[OF h k', symmetric]
         by(rule \<epsilon>.current_plus_current_minus)
       then have "current (\<Gamma> \<ominus> \<epsilon> \<ominus> ?g) (plus_current (plus_current h k) ?g - ?g)" using g'
         by(rule \<epsilon>.current_minus)(auto simp add: add_increasing)
       then have h'': "current (\<Gamma> \<ominus> ?\<epsilon>') ?h'"
         by(rule arg_cong2[where f=current, THEN iffD1, rotated -1])
           (simp_all add: minus_plus_current[OF \<epsilon> g'] fun_eq_iff add_diff_eq_ennreal[symmetric])
       moreover have "wave (\<Gamma> \<ominus> ?\<epsilon>') ?h'"
       proof
         have "separating (\<Gamma> \<ominus> \<epsilon>) (TER\<^bsub>\<Gamma> \<ominus> \<epsilon>\<^esub> (plus_current h k))"
           using k k_w unfolding F_simps minus_plus_current[OF \<epsilon> h]
           by(intro waveD_separating \<epsilon>.wave_plus_current_minus[OF h h_w])
         moreover have "TER\<^bsub>\<Gamma> \<ominus> \<epsilon>\<^esub> (plus_current h k) \<subseteq> TER\<^bsub>\<Gamma> \<ominus> ?\<epsilon>'\<^esub> (plus_current h k)"
           by(auto 4 4 simp add: SAT.simps weight_minus_web[OF \<epsilon>] weight_minus_web[OF \<epsilon>'] split: if_split_asm elim: order_trans[rotated] intro!: ennreal_minus_mono d_IN_mono add_increasing2 \<delta>_nonneg)
         ultimately show sep: "separating (\<Gamma> \<ominus> ?\<epsilon>') (TER\<^bsub>\<Gamma> \<ominus> ?\<epsilon>'\<^esub> ?h')"
           by(simp add: minus_plus_current[OF \<epsilon> g'] separating_weakening)
       qed(rule h'')
       moreover
       have "\<not> hindered (\<Gamma> \<ominus> F (?\<epsilon>', ?h'))" using unhindered'
       proof(rule contrapos_nn)
         assume "hindered (\<Gamma> \<ominus> F (?\<epsilon>', ?h'))"
         thus "hindered ?\<Omega>"
         proof(rule hindered_mono_web[rotated -1])
           show "weight ?\<Omega> z = weight (\<Gamma> \<ominus> F (?\<epsilon>', ?h')) z" if "z \<notin> A (\<Gamma> \<ominus> F (?\<epsilon>', ?h'))" for z
             using that unfolding F'
             apply(cases "z = y")
             apply(simp_all add: \<Omega>_def minus_plus_current[OF fk g] \<Gamma>'.weight_minus_web[OF g] IN_g)
             apply(simp_all add: plus_current_def d_IN_add diff_add_eq_diff_diff_swap_ennreal currentD_finite_IN[OF f])
             done
           have "y \<noteq> a" using y_B a disjoint by auto
           then show "weight (\<Gamma> \<ominus> F (?\<epsilon>', ?h')) z \<le> weight ?\<Omega> z" if "z \<in> A (\<Gamma> \<ominus> F (?\<epsilon>', ?h'))" for z
             using that y_B disjoint \<delta>_nonneg unfolding F'
             apply(cases "z = a")
             apply(simp_all add: \<Omega>_def minus_plus_current[OF fk g] \<Gamma>'.weight_minus_web[OF g] OUT_g)
             apply(auto simp add: plus_current_def d_OUT_add diff_add_eq_diff_diff_swap_ennreal currentD_finite_OUT[OF f])
             done
         qed(simp_all add: \<Omega>_def)
       qed
       ultimately have "(?\<epsilon>', ?h') \<in> Field leq" by-(rule F_I)
       with Pair le sat that show ?thesis by(auto)
     next
       case False
       with currentD_weight_OUT[OF fk, of a] have "d_OUT ?fk a = weight \<Gamma> a" by simp
       have "sat \<epsilon>h = \<epsilon>h" using False Pair by(simp add: sat_def k_def)
       thus ?thesis using that Pair by(auto)
     qed
   qed
 
   have "bourbaki_witt_fixpoint Sup leq sat" using increasing chain_Field unfolding leq_def
     by(intro bourbaki_witt_fixpoint_restrict_rel)(auto intro: Sup_upper Sup_least)
   then interpret bourbaki_witt_fixpoint Sup leq sat .
 
   define f where "f = fixp_above (zero_current, zero_current)"
   have Field: "f \<in> Field leq" using fixp_above_Field[OF zero] unfolding f_def .
   then have f: "current \<Gamma> (F f)" and unhindered: "\<not> hindered (\<Gamma> \<ominus> F f)"
     by(cases f; simp add: f unhindered'; fail)+
   interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> F f" using f by(rule countable_bipartite_web_minus_web)
   note [simp] = weight_minus_web[OF f]
   have Field': "(fst f, snd f) \<in> Field leq" using Field by simp
 
   let ?P_k = "\<lambda>k. current (\<Gamma> \<ominus> F f) k \<and> wave (\<Gamma> \<ominus> F f) k \<and> (\<forall>k'. current (\<Gamma> \<ominus> F f) k' \<and> wave (\<Gamma> \<ominus> F f) k' \<and> k \<le> k' \<longrightarrow> k = k')"
   define k where "k = Eps ?P_k"
   have "Ex ?P_k" by(intro ex_maximal_wave)(simp_all)
   hence "?P_k k" unfolding k_def by(rule someI_ex)
   hence k: "current (\<Gamma> \<ominus> F f) k" and k_w: "wave (\<Gamma> \<ominus> F f) k"
     and maximal: "\<And>k'. \<lbrakk> current (\<Gamma> \<ominus> F f) k'; wave (\<Gamma> \<ominus> F f) k'; k \<le> k' \<rbrakk> \<Longrightarrow> k = k'" by blast+
   note [simp] = \<Gamma>.weight_minus_web[OF k]
 
   let ?fk = "plus_current (F f) k"
   have IN_fk: "d_IN ?fk x = d_IN (F f) x + d_IN k x" for x
     by(simp add: d_IN_def nn_integral_add)
   have OUT_fk: "d_OUT ?fk x = d_OUT (F f) x + d_OUT k x" for x
     by(simp add: d_OUT_def nn_integral_add)
   have fk: "current \<Gamma> ?fk" using f k by(rule current_plus_current_minus)
 
   have "d_OUT ?fk a \<ge> weight \<Gamma> a"
   proof(rule ccontr)
     assume "\<not> ?thesis"
     hence less: "d_OUT ?fk a < weight \<Gamma> a" by simp
 
     define \<Omega> where "\<Omega> = \<Gamma> \<ominus> F f \<ominus> k"
     have B_\<Omega> [simp]: "B \<Omega> = B \<Gamma>" by(simp add: \<Omega>_def)
 
     have loose: "loose \<Omega>" unfolding \<Omega>_def using unhindered k k_w maximal by(rule \<Gamma>.loose_minus_web)
     interpret \<Omega>: countable_bipartite_web \<Omega> using k unfolding \<Omega>_def
       by(rule \<Gamma>.countable_bipartite_web_minus_web)
 
     have a_\<E>: "a \<in> TER\<^bsub>\<Gamma> \<ominus> F f\<^esub> k" using Field k k_w less by(rule a_TER)
     then have "weight \<Omega> a = weight \<Gamma> a - d_OUT (F f) a"
       using a disjoint by(auto simp add: roofed_circ_def \<Omega>_def SINK.simps)
     then have weight_a: "0 < weight \<Omega> a" using less a_\<E>
       by(simp add: OUT_fk SINK.simps diff_gr0_ennreal)
 
     let ?P_y = "\<lambda>y. y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Omega>\<^esub> a \<and> weight \<Omega> y > 0"
     define y where "y = Eps ?P_y"
     have "Ex ?P_y" using Field k k_w less unfolding \<Omega>_def by(rule Ex_y)
     hence "?P_y y" unfolding y_def by(rule someI_ex)
     hence "y \<in> \<^bold>O\<^bold>U\<^bold>T\<^bsub>\<Omega>\<^esub> a" and weight_y: "weight \<Omega> y > 0" by blast+
     then have y_B: "y \<in> B \<Omega>" by(auto simp add: outgoing_def \<Omega>_def dest: bipartite_E)
 
     define bound where "bound = enn2real (min (weight \<Omega> a) (weight \<Omega> y))"
     have bound_pos: "bound > 0" using weight_y weight_a \<Omega>.weight_finite
       by(cases "weight \<Omega> a" "weight \<Omega> y" rule: ennreal2_cases)
         (simp_all add: bound_def min_def split: if_split_asm)
 
     let ?P_\<delta> = "\<lambda>\<delta>. \<delta> > 0 \<and> \<delta> < bound \<and> \<not> hindered (reduce_weight \<Omega> y \<delta>)"
     define \<delta> where "\<delta> = Eps ?P_\<delta>"
     from \<Omega>.unhinder[OF loose _ weight_y bound_pos] y_B disjoint have "Ex ?P_\<delta>" by(auto simp add: \<Omega>_def)
     hence "?P_\<delta> \<delta>" unfolding \<delta>_def by(rule someI_ex)
     hence \<delta>_pos: "0 < \<delta>" by blast+
 
     let ?f' = "(plus_current (fst f) (zero_current((a, y) := \<delta>)), plus_current (snd f) k)"
     have sat: "?f' = sat f" using less by(simp add: sat_def k_def \<Omega>_def Let_def y_def bound_def \<delta>_def split_def)
     also have "\<dots> = f" unfolding f_def using fixp_above_unfold[OF zero] by simp
     finally have "fst ?f' (a, y) = fst f (a, y)" by simp
     hence "\<delta> = 0" using currentD_finite[OF \<epsilon>_curr[OF Field']] \<delta>_pos
       by(cases "fst f (a, y)") simp_all
     with \<delta>_pos show False by simp
   qed
 
   with currentD_weight_OUT[OF fk, of a] have "d_OUT ?fk a = weight \<Gamma> a" by simp
   moreover have "current \<Gamma> ?fk" using f k by(rule current_plus_current_minus)
   moreover have "\<not> hindered (\<Gamma> \<ominus> ?fk)" unfolding minus_plus_current[OF f k]
     using unhindered k k_w by(rule \<Gamma>.unhindered_minus_web)
   ultimately show ?thesis by blast
 qed
 
 end
 
 subsection \<open>Linkability of unhindered bipartite webs\<close>
 
 context countable_bipartite_web begin
 
 theorem unhindered_linkable:
   assumes unhindered: "\<not> hindered \<Gamma>"
   shows "linkable \<Gamma>"
 proof(cases "A \<Gamma> = {}")
   case True
   thus ?thesis by(auto intro!: exI[where x="zero_current"] linkage.intros simp add: web_flow_iff )
 next
   case nempty: False
 
   let ?P = "\<lambda>f a f'. current (\<Gamma> \<ominus> f) f' \<and> d_OUT f' a = weight (\<Gamma> \<ominus> f) a \<and> \<not> hindered (\<Gamma> \<ominus> f \<ominus> f')"
 
   define enum where "enum = from_nat_into (A \<Gamma>)"
   have enum_A: "enum n \<in> A \<Gamma>" for n using from_nat_into[OF nempty, of n] by(simp add: enum_def)
   have vertex_enum [simp]: "vertex \<Gamma> (enum n)" for n using enum_A[of n] A_vertex by blast
 
   define f where "f = rec_nat zero_current (\<lambda>n f. let f' = SOME f'. ?P f (enum n) f' in plus_current f f')"
   have f_0 [simp]: "f 0 = zero_current" by(simp add: f_def)
   have f_Suc: "f (Suc n) = plus_current (f n) (Eps (?P (f n) (enum n)))" for n by(simp add: f_def)
 
   have f: "current \<Gamma> (f n)"
     and sat: "\<And>m. m < n \<Longrightarrow> d_OUT (f n) (enum m) = weight \<Gamma> (enum m)"
     and unhindered: "\<not> hindered (\<Gamma> \<ominus> f n)" for n
   proof(induction n)
     case 0
-    { case 1 thus ?case bysimp }
+    { case 1 thus ?case by simp }
     { case 2 thus ?case by simp }
     { case 3 thus ?case using unhindered by simp }
   next
     case (Suc n)
     interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> f n" using Suc.IH(1) by(rule countable_bipartite_web_minus_web)
 
     define f' where "f' = Eps (?P (f n) (enum n))"
     have "Ex (?P (f n) (enum n))" using Suc.IH(3) by(rule \<Gamma>.unhindered_saturate1)(simp add: enum_A)
     hence "?P (f n) (enum n) f'" unfolding f'_def by(rule someI_ex)
     hence f': "current (\<Gamma> \<ominus> f n) f'"
       and OUT: "d_OUT f' (enum n) = weight (\<Gamma> \<ominus> f n) (enum n)"
       and unhindered': "\<not> hindered (\<Gamma> \<ominus> f n \<ominus> f')" by blast+
     have f_Suc: "f (Suc n) = plus_current (f n) f'" by(simp add: f'_def f_Suc)
     { case 1 show ?case unfolding f_Suc using Suc.IH(1) f' by(rule current_plus_current_minus) }
     note f'' = this
     { case (2 m)
       have "d_OUT (f (Suc n)) (enum m) \<le> weight \<Gamma> (enum m)" using f'' by(rule currentD_weight_OUT)
       moreover have "weight \<Gamma> (enum m) \<le> d_OUT (f (Suc n)) (enum m)"
       proof(cases "m = n")
         case True
         then show ?thesis unfolding f_Suc using OUT True
           by(simp add: d_OUT_def nn_integral_add enum_A add_diff_self_ennreal less_imp_le)
       next
         case False
         hence "m < n" using 2 by simp
         thus ?thesis using Suc.IH(2)[OF \<open>m < n\<close>] unfolding f_Suc
           by(simp add: d_OUT_def nn_integral_add add_increasing2 )
       qed
       ultimately show ?case by(rule antisym) }
     { case 3 show ?case unfolding f_Suc minus_plus_current[OF Suc.IH(1) f'] by(rule unhindered') }
   qed
   interpret \<Gamma>: countable_bipartite_web "\<Gamma> \<ominus> f n" for n using f by(rule countable_bipartite_web_minus_web)
 
   have Ex_P: "Ex (?P (f n) (enum n))" for n using unhindered by(rule \<Gamma>.unhindered_saturate1)(simp add: enum_A)
   have f_mono: "f n \<le> f (Suc n)" for n using someI_ex[OF Ex_P, of n]
     by(auto simp add: le_fun_def f_Suc enum_A intro: add_increasing2 dest: )
   hence incseq: "incseq f" by(rule incseq_SucI)
   hence chain: "Complete_Partial_Order.chain (\<le>) (range f)" by(rule incseq_chain_range)
 
   define g where "g = Sup (range f)"
   have "support_flow g \<subseteq> \<^bold>E"
     by (auto simp add: g_def support_flow.simps currentD_outside [OF f] image_comp elim: contrapos_pp)
   then have countable_g: "countable (support_flow g)" by(rule countable_subset) simp
   with chain _ _ have g: "current \<Gamma> g" unfolding g_def  by(rule current_Sup)(auto simp add: f)
   moreover
   have "d_OUT g x = weight \<Gamma> x" if "x \<in> A \<Gamma>" for x
   proof(rule antisym)
     show "d_OUT g x \<le> weight \<Gamma> x" using g by(rule currentD_weight_OUT)
     have "countable (A \<Gamma>)" using A_vertex by(rule countable_subset) simp
     from that subset_range_from_nat_into[OF this] obtain n where "x = enum n" unfolding enum_def by blast
     with sat[of n "Suc n"] have "d_OUT (f (Suc n)) x \<ge> weight \<Gamma> x" by simp
     then show "weight \<Gamma> x \<le> d_OUT g x" using countable_g unfolding g_def
       by(subst d_OUT_Sup[OF chain])(auto intro: SUP_upper2)
   qed
   ultimately show ?thesis by(auto simp add: web_flow_iff linkage.simps)
 qed
 
 end
 
 
 context countable_web begin
 
 theorem loose_linkable: \<comment> \<open>Theorem 6.2\<close>
   assumes "loose \<Gamma>"
   shows "linkable \<Gamma>"
 proof -
   interpret bi: countable_bipartite_web "bipartite_web_of \<Gamma>" by(rule countable_bipartite_web_of)
   have "\<not> hindered (bipartite_web_of \<Gamma>)" using assms by(rule unhindered_bipartite_web_of)
   then have "linkable (bipartite_web_of \<Gamma>)"
     by(rule bi.unhindered_linkable)
   then show ?thesis by(rule linkable_bipartite_web_ofD) simp
 qed
 
 lemma ex_orthogonal_current: \<comment> \<open>Lemma 4.15\<close>
   "\<exists>f S. web_flow \<Gamma> f \<and> separating \<Gamma> S \<and> orthogonal_current \<Gamma> f S"
   by(rule ex_orthogonal_current')(rule countable_web.loose_linkable[OF countable_web_quotient_web])
 
 end
 
 subsection \<open>Glueing the reductions together\<close>
 
 context countable_network begin
 
 context begin
 
 qualified lemma max_flow_min_cut':
   assumes source_in: "\<And>x. \<not> edge \<Delta> x (source \<Delta>)"
   and sink_out: "\<And>y. \<not> edge \<Delta> (sink \<Delta>) y"
   and undead: "\<And>x y. edge \<Delta> x y \<Longrightarrow> (\<exists>z. edge \<Delta> y z) \<or> (\<exists>z. edge \<Delta> z x)"
   and source_sink: "\<not> edge \<Delta> (source \<Delta>) (sink \<Delta>)"
   and no_loop: "\<And>x. \<not> edge \<Delta> x x"
   and capacity_pos: "\<And>e. e \<in> \<^bold>E \<Longrightarrow> capacity \<Delta> e > 0"
   shows "\<exists>f S. flow \<Delta> f \<and> cut \<Delta> S \<and> orthogonal \<Delta> f S"
   by(rule max_flow_min_cut')(rule countable_web.ex_orthogonal_current[OF countable_web_web_of_network], fact+)
 
 qualified lemma max_flow_min_cut'':
   assumes sink_out: "\<And>y. \<not> edge \<Delta> (sink \<Delta>) y"
   and source_in: "\<And>x. \<not> edge \<Delta> x (source \<Delta>)"
   and no_loop: "\<And>x. \<not> edge \<Delta> x x"
   and capacity_pos: "\<And>e. e \<in> \<^bold>E \<Longrightarrow> capacity \<Delta> e > 0"
   shows "\<exists>f S. flow \<Delta> f \<and> cut \<Delta> S \<and> orthogonal \<Delta> f S"
 proof -
   interpret antiparallel_edges \<Delta> ..
   interpret \<Delta>'': countable_network \<Delta>'' by(rule \<Delta>''_countable_network)
   have "\<exists>f S. flow \<Delta>'' f \<and> cut \<Delta>'' S \<and> orthogonal \<Delta>'' f S"
     by(rule \<Delta>''.max_flow_min_cut')(auto simp add: sink_out source_in no_loop capacity_pos elim: edg.cases)
   then obtain f S where f: "flow \<Delta>'' f" and cut: "cut \<Delta>'' S" and ortho: "orthogonal \<Delta>'' f S" by blast
   have "flow \<Delta> (collect f)" using f by(rule flow_collect)
   moreover have "cut \<Delta> (cut' S)" using cut by(rule cut_cut')
   moreover have "orthogonal \<Delta> (collect f) (cut' S)" using ortho f by(rule orthogonal_cut')
   ultimately show ?thesis by blast
 qed
 
 qualified lemma max_flow_min_cut''':
   assumes sink_out: "\<And>y. \<not> edge \<Delta> (sink \<Delta>) y"
   and source_in: "\<And>x. \<not> edge \<Delta> x (source \<Delta>)"
   and capacity_pos: "\<And>e. e \<in> \<^bold>E \<Longrightarrow> capacity \<Delta> e > 0"
   shows "\<exists>f S. flow \<Delta> f \<and> cut \<Delta> S \<and> orthogonal \<Delta> f S"
 proof -
   interpret antiparallel_edges \<Delta> ..
   interpret \<Delta>'': countable_network \<Delta>'' by(rule \<Delta>''_countable_network)
   have "\<exists>f S. flow \<Delta>'' f \<and> cut \<Delta>'' S \<and> orthogonal \<Delta>'' f S"
     by(rule \<Delta>''.max_flow_min_cut'')(auto simp add: sink_out source_in capacity_pos elim: edg.cases)
   then obtain f S where f: "flow \<Delta>'' f" and cut: "cut \<Delta>'' S" and ortho: "orthogonal \<Delta>'' f S" by blast
   have "flow \<Delta> (collect f)" using f by(rule flow_collect)
   moreover have "cut \<Delta> (cut' S)" using cut by(rule cut_cut')
   moreover have "orthogonal \<Delta> (collect f) (cut' S)" using ortho f by(rule orthogonal_cut')
   ultimately show ?thesis by blast
 qed
 
 theorem max_flow_min_cut:
   "\<exists>f S. flow \<Delta> f \<and> cut \<Delta> S \<and> orthogonal \<Delta> f S"
 proof -
   interpret \<Delta>''': countable_network \<Delta>''' by(rule \<Delta>'''_countable_network)
   have "\<exists>f S. flow \<Delta>''' f \<and> cut \<Delta>''' S \<and> orthogonal \<Delta>''' f S" by(rule \<Delta>'''.max_flow_min_cut''') auto
   then obtain f S where f: "flow \<Delta>''' f" and cut: "cut \<Delta>''' S" and ortho: "orthogonal \<Delta>''' f S" by blast
   from flow_\<Delta>'''[OF this] show ?thesis by blast
 qed
 
 end
 
 end
 
 end
diff --git a/thys/MFMC_Countable/MFMC_Web.thy b/thys/MFMC_Countable/MFMC_Web.thy
--- a/thys/MFMC_Countable/MFMC_Web.thy
+++ b/thys/MFMC_Countable/MFMC_Web.thy
@@ -1,1973 +1,1973 @@
 theory MFMC_Web imports
   MFMC_Network
 begin
 
 section \<open>Webs and currents\<close>
 
 record 'v web = "'v graph" +
   weight :: "'v \<Rightarrow> ennreal"
   A :: "'v set"
   B :: "'v set"
 
 lemma vertex_weight_update [simp]: "vertex (weight_update f \<Gamma>) = vertex \<Gamma>"
 by(simp add: vertex_def fun_eq_iff)
 
 type_synonym 'v current = "'v edge \<Rightarrow> ennreal"
 
 inductive current :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> bool"
   for \<Gamma> f
 where
   current:
   "\<lbrakk> \<And>x. d_OUT f x \<le> weight \<Gamma> x;
      \<And>x. d_IN f x \<le> weight \<Gamma> x;
      \<And>x. x \<notin> A \<Gamma> \<Longrightarrow> d_OUT f x \<le> d_IN f x;
      \<And>a. a \<in> A \<Gamma> \<Longrightarrow> d_IN f a = 0;
      \<And>b. b \<in> B \<Gamma> \<Longrightarrow> d_OUT f b = 0;
      \<And>e. e \<notin> \<^bold>E\<^bsub>\<Gamma>\<^esub> \<Longrightarrow> f e = 0 \<rbrakk>
   \<Longrightarrow> current \<Gamma> f"
 
 lemma currentD_weight_OUT: "current \<Gamma> f \<Longrightarrow> d_OUT f x \<le> weight \<Gamma> x"
 by(simp add: current.simps)
 
 lemma currentD_weight_IN: "current \<Gamma> f \<Longrightarrow> d_IN f x \<le> weight \<Gamma> x"
 by(simp add: current.simps)
 
 lemma currentD_OUT_IN: "\<lbrakk> current \<Gamma> f; x \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f x \<le> d_IN f x"
 by(simp add: current.simps)
 
 lemma currentD_IN: "\<lbrakk> current \<Gamma> f; a \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> d_IN f a = 0"
 by(simp add: current.simps)
 
 lemma currentD_OUT: "\<lbrakk> current \<Gamma> f; b \<in> B \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f b = 0"
 by(simp add: current.simps)
 
 lemma currentD_outside: "\<lbrakk> current \<Gamma> f; \<not> edge \<Gamma> x y \<rbrakk> \<Longrightarrow> f (x, y) = 0"
 by(blast elim: current.cases)
 
 lemma currentD_outside': "\<lbrakk> current \<Gamma> f; e \<notin> \<^bold>E\<^bsub>\<Gamma>\<^esub> \<rbrakk> \<Longrightarrow> f e = 0"
 by(blast elim: current.cases)
 
 lemma currentD_OUT_eq_0:
   assumes "current \<Gamma> f"
   shows "d_OUT f x = 0 \<longleftrightarrow> (\<forall>y. f (x, y) = 0)"
 by(simp add: d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0)
 
 lemma currentD_IN_eq_0:
   assumes "current \<Gamma> f"
   shows "d_IN f x = 0 \<longleftrightarrow> (\<forall>y. f (y, x) = 0)"
 by(simp add: d_IN_def nn_integral_0_iff emeasure_count_space_eq_0)
 
 lemma current_support_flow:
   fixes \<Gamma> (structure)
   assumes "current \<Gamma> f"
   shows "support_flow f \<subseteq> \<^bold>E"
 using currentD_outside[OF assms] by(auto simp add: support_flow.simps intro: ccontr)
 
 lemma currentD_outside_IN: "\<lbrakk> current \<Gamma> f; x \<notin> \<^bold>V\<^bsub>\<Gamma>\<^esub> \<rbrakk> \<Longrightarrow> d_IN f x = 0"
 by(auto simp add: d_IN_def vertex_def nn_integral_0_iff  AE_count_space emeasure_count_space_eq_0 dest: currentD_outside)
 
 lemma currentD_outside_OUT: "\<lbrakk> current \<Gamma> f; x \<notin> \<^bold>V\<^bsub>\<Gamma>\<^esub> \<rbrakk> \<Longrightarrow> d_OUT f x = 0"
 by(auto simp add: d_OUT_def vertex_def nn_integral_0_iff  AE_count_space emeasure_count_space_eq_0 dest: currentD_outside)
 
 lemma currentD_weight_in: "current \<Gamma> h \<Longrightarrow> h (x, y) \<le> weight \<Gamma> y"
   by (metis order_trans d_IN_ge_point currentD_weight_IN)
 
 lemma currentD_weight_out: "current \<Gamma> h \<Longrightarrow> h (x, y) \<le> weight \<Gamma> x"
   by (metis order_trans d_OUT_ge_point currentD_weight_OUT)
 
 lemma current_leI:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and le: "\<And>e. g e \<le> f e"
   and OUT_IN: "\<And>x. x \<notin> A \<Gamma> \<Longrightarrow> d_OUT g x \<le> d_IN g x"
   shows "current \<Gamma> g"
 proof
   show "d_OUT g x \<le> weight \<Gamma> x" for x
     using d_OUT_mono[of g x f, OF le] currentD_weight_OUT[OF f] by(rule order_trans)
   show "d_IN g x \<le> weight \<Gamma> x" for x
     using d_IN_mono[of g x f, OF le] currentD_weight_IN[OF f] by(rule order_trans)
   show "d_IN g a = 0" if "a \<in> A \<Gamma>" for a
     using d_IN_mono[of g a f, OF le] currentD_IN[OF f that] by auto
   show "d_OUT g b = 0" if "b \<in> B \<Gamma>" for b
     using d_OUT_mono[of g b f, OF le] currentD_OUT[OF f that] by auto
   show "g e = 0" if "e \<notin> \<^bold>E" for e
     using currentD_outside'[OF f that] le[of e] by simp
 qed(blast intro: OUT_IN)+
 
 lemma current_weight_mono:
   "\<lbrakk> current \<Gamma> f; edge \<Gamma> = edge \<Gamma>'; A \<Gamma> = A \<Gamma>'; B \<Gamma> = B \<Gamma>'; \<And>x. weight \<Gamma> x \<le> weight \<Gamma>' x \<rbrakk>
   \<Longrightarrow> current \<Gamma>' f"
 by(auto 4 3 elim!: current.cases intro!: current.intros intro: order_trans)
 
 abbreviation (input) zero_current :: "'v current"
 where "zero_current \<equiv> \<lambda>_. 0"
 
 lemma SINK_0 [simp]: "SINK zero_current = UNIV"
 by(auto simp add: SINK.simps)
 
 lemma current_0 [simp]: "current \<Gamma> zero_current"
 by(auto simp add: current.simps)
 
 inductive web_flow :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> bool"
   for \<Gamma> (structure) and f
 where
   web_flow: "\<lbrakk> current \<Gamma> f; \<And>x. \<lbrakk> x \<in> \<^bold>V; x \<notin> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> KIR f x \<rbrakk> \<Longrightarrow> web_flow \<Gamma> f"
 
 lemma web_flowD_current: "web_flow \<Gamma> f \<Longrightarrow> current \<Gamma> f"
 by(erule web_flow.cases)
 
 lemma web_flowD_KIR: "\<lbrakk> web_flow \<Gamma> f; x \<notin> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> KIR f x"
 apply(cases "x \<in> \<^bold>V\<^bsub>\<Gamma>\<^esub>")
  apply(fastforce elim!: web_flow.cases)
 apply(auto simp add: vertex_def d_OUT_def d_IN_def elim!: web_flow.cases)
 apply(subst (1 2) currentD_outside[of _ f]; auto)
 done
 
 subsection \<open>Saturated and terminal vertices\<close>
 
 inductive_set SAT :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v set"
   for \<Gamma> f
 where
   A: "x \<in> A \<Gamma> \<Longrightarrow> x \<in> SAT \<Gamma> f"
 | IN: "d_IN f x \<ge> weight \<Gamma> x \<Longrightarrow> x \<in> SAT \<Gamma> f"
   \<comment> \<open>We use @{text "\<ge> weight"} such that @{text SAT} is monotone w.r.t. increasing currents\<close>
 
 lemma SAT_0 [simp]: "SAT \<Gamma> zero_current = A \<Gamma> \<union> {x. weight \<Gamma> x \<le> 0}"
 by(auto simp add: SAT.simps)
 
 lemma SAT_mono:
   assumes "\<And>e. f e \<le> g e"
   shows "SAT \<Gamma> f \<subseteq> SAT \<Gamma> g"
 proof
   fix x
   assume "x \<in> SAT \<Gamma> f"
   thus "x \<in> SAT \<Gamma> g"
   proof cases
     case IN
     also have "d_IN f x \<le> d_IN g x" using assms by(rule d_IN_mono)
     finally show ?thesis ..
   qed(rule SAT.A)
 qed
 
 lemma SAT_Sup_upper: "f \<in> Y \<Longrightarrow> SAT \<Gamma> f \<subseteq> SAT \<Gamma> (Sup Y)"
 by(rule SAT_mono)(rule Sup_upper[THEN le_funD])
 
 lemma currentD_SAT:
   assumes "current \<Gamma> f"
   shows "x \<in> SAT \<Gamma> f \<longleftrightarrow> x \<in> A \<Gamma> \<or> d_IN f x = weight \<Gamma> x"
 using currentD_weight_IN[OF assms, of x] by(auto simp add: SAT.simps)
 
 abbreviation terminal :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v set" ("TER\<index>")
 where "terminal \<Gamma> f \<equiv> SAT \<Gamma> f \<inter> SINK f"
 
 subsection \<open>Separation\<close>
 
 inductive separating_gen :: "('v, 'more) graph_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set \<Rightarrow> 'v set \<Rightarrow> bool"
   for G A B S
 where separating:
   "(\<And>x y p. \<lbrakk> x \<in> A; y \<in> B; path G x p y \<rbrakk> \<Longrightarrow> (\<exists>z \<in> set p. z \<in> S) \<or> x \<in> S)
   \<Longrightarrow> separating_gen G A B S"
 
 abbreviation separating :: "('v, 'more) web_scheme \<Rightarrow> 'v set \<Rightarrow> bool"
 where "separating \<Gamma> \<equiv> separating_gen \<Gamma> (A \<Gamma>) (B \<Gamma>)"
 
 abbreviation separating_network :: "('v, 'more) network_scheme \<Rightarrow> 'v set \<Rightarrow> bool"
 where "separating_network \<Delta> \<equiv> separating_gen \<Delta> {source \<Delta>} {sink \<Delta>}"
 
 lemma separating_networkI [intro?]:
   "(\<And>p. path \<Delta> (source \<Delta>) p (sink \<Delta>) \<Longrightarrow> (\<exists>z \<in> set p. z \<in> S) \<or> source \<Delta> \<in> S)
   \<Longrightarrow> separating_network \<Delta> S"
 by(auto intro: separating)
 
 lemma separatingD:
   "\<And>A B. \<lbrakk> separating_gen G A B S; path G x p y; x \<in> A; y \<in> B \<rbrakk> \<Longrightarrow> (\<exists>z \<in> set p. z \<in> S) \<or> x \<in> S"
 by(blast elim: separating_gen.cases)
 
 lemma separating_left [simp]: "\<And>A B. A \<subseteq> A' \<Longrightarrow> separating_gen \<Gamma> A B A'"
 by(auto simp add: separating_gen.simps)
 
 lemma separating_weakening:
   "\<And>A B. \<lbrakk> separating_gen G A B S; S \<subseteq> S' \<rbrakk> \<Longrightarrow> separating_gen G A B S'"
 by(rule separating; drule (3) separatingD; blast)
 
 definition essential :: "('v, 'more) graph_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set \<Rightarrow> 'v \<Rightarrow> bool"
 where \<comment> \<open>Should we allow only simple paths here?\<close>
   "\<And>B. essential G B S x \<longleftrightarrow> (\<exists>p. \<exists>y\<in>B. path G x p y \<and> (x \<noteq> y \<longrightarrow> (\<forall>z\<in>set p. z = x \<or> z \<notin> S)))"
 
 abbreviation essential_web :: "('v, 'more) web_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set" ("\<E>\<index>")
 where "essential_web \<Gamma> S \<equiv> {x\<in>S. essential \<Gamma> (B \<Gamma>) S x}"
 
 lemma essential_weight_update [simp]:
   "essential (weight_update f G) = essential G"
 by(simp add: essential_def fun_eq_iff)
 
 lemma not_essentialD:
   "\<And>B. \<lbrakk> \<not> essential G B S x; path G x p y; y \<in> B \<rbrakk> \<Longrightarrow> x \<noteq> y \<and> (\<exists>z\<in>set p. z \<noteq> x \<and> z \<in> S)"
 by(simp add: essential_def)
 
 lemma essentialE [elim?, consumes 1, case_names essential, cases pred: essential]:
   "\<And>B. \<lbrakk> essential G B S x; \<And>p y. \<lbrakk> path G x p y; y \<in> B; \<And>z. \<lbrakk> x \<noteq> y; z \<in> set p \<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> S \<rbrakk> \<Longrightarrow> thesis \<rbrakk> \<Longrightarrow> thesis"
 by(auto simp add: essential_def)
 
 lemma essentialI [intro?]:
   "\<And>B. \<lbrakk> path G x p y; y \<in> B; \<And>z. \<lbrakk> x \<noteq> y; z \<in> set p \<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> S \<rbrakk> \<Longrightarrow> essential G B S x"
 by(auto simp add: essential_def)
 
 lemma essential_vertex: "\<And>B. \<lbrakk> essential G B S x; x \<notin> B \<rbrakk> \<Longrightarrow>vertex G x"
 by(auto elim!: essentialE simp add: vertex_def elim: rtrancl_path.cases)
 
 lemma essential_BI: "\<And>B. x \<in> B \<Longrightarrow> essential G B S x"
 by(auto simp add: essential_def intro: rtrancl_path.base)
 
 lemma \<E>_E [elim?, consumes 1, case_names \<E>, cases set: essential_web]:
   fixes \<Gamma> (structure)
   assumes "x \<in> \<E> S"
   obtains p y where "path \<Gamma> x p y" "y \<in> B \<Gamma>" "\<And>z. \<lbrakk> x \<noteq> y; z \<in> set p \<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> S"
 using assms by(auto elim: essentialE)
 
 lemma essential_mono: "\<And>B. \<lbrakk> essential G B S x; S' \<subseteq> S \<rbrakk> \<Longrightarrow> essential G B S' x"
 by(auto simp add: essential_def)
 
 lemma separating_essential: \<comment> \<open>Lem. 3.4 (cf. Lem. 2.14 in [5])\<close>
   fixes G A B S
   assumes "separating_gen G A B S"
   shows "separating_gen G A B {x\<in>S. essential G B S x}" (is "separating_gen _ _ _ ?E")
 proof
   fix x y p
   assume x: "x \<in> A" and y: "y \<in> B" and p: "path G x p y"
   from separatingD[OF assms p x y] have "\<exists>z \<in> set (x # p). z \<in> S" by auto
   from split_list_last_prop[OF this] obtain ys z zs where decomp: "x # p = ys @ z # zs"
     and z: "z \<in> S" and last: "\<And>z. z \<in> set zs \<Longrightarrow> z \<notin> S" by auto
   from decomp consider (empty) "ys = []" "x = z" "p = zs"
     | (Cons) ys' where "ys = x # ys'" "p = ys' @ z # zs"
     by(auto simp add: Cons_eq_append_conv)
   then show "(\<exists>z\<in>set p. z \<in> ?E) \<or> x \<in> ?E"
   proof(cases)
     case empty
     hence "x \<in> ?E" using z p last y by(auto simp add: essential_def)
     thus ?thesis ..
   next
     case (Cons ys')
     from p have "path G z zs y" unfolding Cons by(rule rtrancl_path_appendE)
     hence "z \<in> ?E" using z y last by(auto simp add: essential_def)
     thus ?thesis using Cons by auto
   qed
 qed
 
 definition roofed_gen :: "('v, 'more) graph_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set \<Rightarrow> 'v set"
 where roofed_def: "\<And>B. roofed_gen G B S = {x. \<forall>p. \<forall>y\<in>B. path G x p y \<longrightarrow> (\<exists>z\<in>set p. z \<in> S) \<or> x \<in> S}"
 
 abbreviation roofed :: "('v, 'more) web_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set" ("RF\<index>")
 where "roofed \<Gamma> \<equiv> roofed_gen \<Gamma> (B \<Gamma>)"
 
 abbreviation roofed_network :: "('v, 'more) network_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set" ("RF\<^sup>N\<index>")
 where "roofed_network \<Delta> \<equiv> roofed_gen \<Delta> {sink \<Delta>}"
 
 lemma roofedI [intro?]:
   "\<And>B. (\<And>p y. \<lbrakk> path G x p y; y \<in> B \<rbrakk> \<Longrightarrow> (\<exists>z\<in>set p. z \<in> S) \<or> x \<in> S) \<Longrightarrow> x \<in> roofed_gen G B S"
 by(auto simp add: roofed_def)
 
 lemma not_roofedE: fixes B
   assumes "x \<notin> roofed_gen G B S"
   obtains p y where "path G x p y" "y \<in> B" "\<And>z. z \<in> set (x # p) \<Longrightarrow> z \<notin> S"
 using assms by(auto simp add: roofed_def)
 
 lemma roofed_greater: "\<And>B. S \<subseteq> roofed_gen G B S"
 by(auto simp add: roofed_def)
 
 lemma roofed_greaterI: "\<And>B. x \<in> S \<Longrightarrow> x \<in> roofed_gen G B S"
 using roofed_greater[of S G] by blast
 
 lemma roofed_mono: "\<And>B. S \<subseteq> S' \<Longrightarrow> roofed_gen G B S \<subseteq> roofed_gen G B S'"
 by(fastforce simp add: roofed_def)
 
 lemma in_roofed_mono: "\<And>B. \<lbrakk> x \<in> roofed_gen G B S; S \<subseteq> S' \<rbrakk> \<Longrightarrow> x \<in> roofed_gen G B S'"
 using roofed_mono[THEN subsetD] .
 
 lemma roofedD: "\<And>B. \<lbrakk> x \<in> roofed_gen G B S; path G x p y; y \<in> B \<rbrakk> \<Longrightarrow> (\<exists>z\<in>set p. z \<in> S) \<or> x \<in> S"
 unfolding roofed_def by blast
 
 lemma separating_RF_A:
   fixes A B
   assumes "separating_gen G A B X"
   shows "A \<subseteq> roofed_gen G B X"
 by(rule subsetI roofedI)+(erule separatingD[OF assms])
 
 lemma roofed_idem: fixes B shows "roofed_gen G B (roofed_gen G B S) = roofed_gen G B S"
 proof(rule equalityI subsetI roofedI)+
   fix x p y
   assume x: "x \<in> roofed_gen G B (roofed_gen G B S)" and p: "path G x p y" and y: "y \<in> B"
   from roofedD[OF x p y] obtain z where *: "z \<in> set (x # p)" and z: "z \<in> roofed_gen G B S" by auto
   from split_list[OF *] obtain ys zs where split: "x # p = ys @ z # zs" by blast
   with p have p': "path G z zs y" by(auto simp add: Cons_eq_append_conv elim: rtrancl_path_appendE)
   from roofedD[OF z p' y] split show "(\<exists>z\<in>set p. z \<in> S) \<or> x \<in> S"
     by(auto simp add: Cons_eq_append_conv)
 qed(rule roofed_mono roofed_greater)+
 
 lemma in_roofed_mono': "\<And>B. \<lbrakk> x \<in> roofed_gen G B S; S \<subseteq> roofed_gen G B S' \<rbrakk> \<Longrightarrow> x \<in> roofed_gen G B S'"
 by(subst roofed_idem[symmetric])(erule in_roofed_mono)
 
 lemma roofed_mono': "\<And>B. S \<subseteq> roofed_gen G B S' \<Longrightarrow> roofed_gen G B S \<subseteq> roofed_gen G B S'"
 by(rule subsetI)(rule in_roofed_mono')
 
 lemma roofed_idem_Un1: fixes B shows "roofed_gen G B (roofed_gen G B S \<union> T) = roofed_gen G B (S \<union> T)"
 proof -
   have "S \<subseteq> T \<union> roofed_gen G B S"
     by (metis (no_types) UnCI roofed_greater subsetCE subsetI)
   then have "S \<union> T \<subseteq> T \<union> roofed_gen G B S \<and> T \<union> roofed_gen G B S \<subseteq> roofed_gen G B (S \<union> T)"
     by (metis (no_types) Un_subset_iff Un_upper2 roofed_greater roofed_mono sup.commute)
   then show ?thesis
     by (metis (no_types) roofed_idem roofed_mono subset_antisym sup.commute)
 qed
 
 lemma roofed_UN: fixes A B
   shows "roofed_gen G B (\<Union>i\<in>A. roofed_gen G B (X i)) = roofed_gen G B (\<Union>i\<in>A. X i)" (is "?lhs = ?rhs")
 proof(rule equalityI)
   show "?rhs \<subseteq> ?lhs" by(rule roofed_mono)(blast intro: roofed_greaterI)
   show "?lhs \<subseteq> ?rhs" by(rule roofed_mono')(blast intro: in_roofed_mono)
 qed
 
 lemma RF_essential: fixes \<Gamma> (structure) shows "RF (\<E> S) = RF S"
 proof(intro set_eqI iffI)
   fix x
   assume RF: "x \<in> RF S"
   show "x \<in> RF (\<E> S)"
   proof
     fix p y
     assume p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     from roofedD[OF RF this] have "\<exists>z\<in>set (x # p). z \<in> S" by auto
     from split_list_last_prop[OF this] obtain ys z zs where decomp: "x # p = ys @ z # zs"
       and z: "z \<in> S" and last: "\<And>z. z \<in> set zs \<Longrightarrow> z \<notin> S" by auto
     from decomp consider (empty) "ys = []" "x = z" "p = zs"
       | (Cons) ys' where "ys = x # ys'" "p = ys' @ z # zs"
       by(auto simp add: Cons_eq_append_conv)
     then show "(\<exists>z\<in>set p. z \<in> \<E> S) \<or> x \<in> \<E> S"
     proof(cases)
       case empty
       hence "x \<in> \<E> S" using z p last y by(auto simp add: essential_def)
       thus ?thesis ..
     next
       case (Cons ys')
       from p have "path \<Gamma> z zs y" unfolding Cons by(rule rtrancl_path_appendE)
       hence "z \<in> \<E> S" using z y last by(auto simp add: essential_def)
       thus ?thesis using Cons by auto
     qed
   qed
 qed(blast intro: in_roofed_mono)
 
 lemma essentialE_RF:
   fixes \<Gamma> (structure) and B
   assumes "essential \<Gamma> B S x"
   obtains p y where "path \<Gamma> x p y" "y \<in> B" "distinct (x # p)" "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> roofed_gen \<Gamma> B S"
 proof -
   from assms obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B"
     and bypass: "\<And>z. \<lbrakk> x \<noteq> y; z \<in> set p \<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> S" by(rule essentialE) blast
   from p obtain p' where p': "path \<Gamma> x p' y" and distinct: "distinct (x # p')"
     and subset: "set p' \<subseteq> set p" by(rule rtrancl_path_distinct)
   { fix z
     assume z: "z \<in> set p'"
     hence "y \<in> set p'" using rtrancl_path_last[OF p', symmetric] p'
       by(auto elim: rtrancl_path.cases intro: last_in_set)
     with distinct z subset have neq: "x \<noteq> y" and "z \<in> set p" by(auto)
     from bypass[OF this] z distinct have "z \<notin> S" by auto
 
     have "z \<notin> roofed_gen \<Gamma> B S"
     proof
       assume z': "z \<in> roofed_gen \<Gamma> B S"
       from split_list[OF z] obtain ys zs where decomp: "p' = ys @ z # zs" by blast
       with p' have "path \<Gamma> z zs y" by(auto elim: rtrancl_path_appendE)
       from roofedD[OF z' this y] \<open>z \<notin> S\<close> obtain z' where "z' \<in> set zs" "z' \<in> S" by auto
       with bypass[of z'] neq decomp subset distinct show False by auto
     qed }
   with p' y distinct show thesis ..
 qed
 
 lemma \<E>_E_RF:
   fixes \<Gamma> (structure)
   assumes "x \<in> \<E> S"
   obtains p y where "path \<Gamma> x p y" "y \<in> B \<Gamma>" "distinct (x # p)" "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF S"
 using assms by(auto elim: essentialE_RF)
 
 lemma in_roofed_essentialD:
   fixes \<Gamma> (structure)
   assumes RF: "x \<in> RF S"
   and ess: "essential \<Gamma> (B \<Gamma>) S x"
   shows "x \<in> S"
 proof -
   from ess obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and "distinct (x # p)"
     and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> S" by(rule essentialE_RF)(auto intro: roofed_greaterI)
   from roofedD[OF RF p y] bypass show "x \<in> S" by auto
 qed
 
 lemma separating_RF: fixes \<Gamma> (structure) shows "separating \<Gamma> (RF S) \<longleftrightarrow> separating \<Gamma> S"
 proof
   assume sep: "separating \<Gamma> (RF S)"
   show "separating \<Gamma> S"
   proof
     fix x y p
     assume p: "path \<Gamma> x p y" and x: "x \<in> A \<Gamma>" and y: "y \<in> B \<Gamma>"
     from separatingD[OF sep p x y] have "\<exists>z \<in> set (x # p). z \<in> RF S" by auto
     from split_list_last_prop[OF this] obtain ys z zs where split: "x # p = ys @ z # zs"
       and z: "z \<in> RF S" and bypass: "\<And>z'. z' \<in> set zs \<Longrightarrow> z' \<notin> RF S" by auto
     from p split have "path \<Gamma> z zs y" by(cases ys)(auto elim: rtrancl_path_appendE)
     hence "essential \<Gamma> (B \<Gamma>) S z" using y
       by(rule essentialI)(auto dest: bypass intro: roofed_greaterI)
     with z have "z \<in> S" by(rule in_roofed_essentialD)
     with split show "(\<exists>z\<in>set p. z \<in> S) \<or> x \<in> S" by(cases ys)auto
   qed
 qed(blast intro: roofed_greaterI separating_weakening)
 
 definition roofed_circ :: "('v, 'more) web_scheme \<Rightarrow> 'v set \<Rightarrow> 'v set" ("RF\<^sup>\<circ>\<index>")
 where "roofed_circ \<Gamma> S = roofed \<Gamma> S - \<E>\<^bsub>\<Gamma>\<^esub> S"
 
 lemma roofed_circI: fixes \<Gamma> (structure) shows
   "\<lbrakk> x \<in> RF T; x \<in> T \<Longrightarrow> \<not> essential \<Gamma> (B \<Gamma>) T x \<rbrakk> \<Longrightarrow> x \<in> RF\<^sup>\<circ> T"
 by(simp add: roofed_circ_def)
 
 lemma roofed_circE:
   fixes \<Gamma> (structure)
   assumes "x \<in> RF\<^sup>\<circ> T"
   obtains "x \<in> RF T" "\<not> essential \<Gamma> (B \<Gamma>) T x"
 using assms by(auto simp add: roofed_circ_def intro: in_roofed_essentialD)
 
 lemma \<E>_\<E>: fixes \<Gamma> (structure) shows "\<E> (\<E> S) = \<E> S"
 by(auto intro: essential_mono)
 
 lemma roofed_circ_essential: fixes \<Gamma> (structure) shows "RF\<^sup>\<circ> (\<E> S) = RF\<^sup>\<circ> S"
 unfolding roofed_circ_def RF_essential \<E>_\<E> ..
 
 lemma essential_RF: fixes B
   shows "essential G B (roofed_gen G B S) = essential G B S"  (is "essential _ _ ?RF = _")
 proof(intro ext iffI)
   show "essential G B S x" if "essential G B ?RF x" for x using that
     by(rule essential_mono)(blast intro: roofed_greaterI)
   show "essential G B ?RF x" if "essential G B S x" for x
     using that by(rule essentialE_RF)(erule (1) essentialI, blast)
 qed
 
 lemma \<E>_RF: fixes \<Gamma> (structure) shows "\<E> (RF S) = \<E> S"
 by(auto dest: in_roofed_essentialD simp add: essential_RF intro: roofed_greaterI)
 
 lemma essential_\<E>: fixes \<Gamma> (structure) shows "essential \<Gamma> (B \<Gamma>) (\<E> S) = essential \<Gamma> (B \<Gamma>) S"
 by(subst essential_RF[symmetric])(simp only: RF_essential essential_RF)
 
 lemma RF_in_B: fixes \<Gamma> (structure) shows "x \<in> B \<Gamma> \<Longrightarrow> x \<in> RF S \<longleftrightarrow> x \<in> S"
 by(auto intro: roofed_greaterI dest: roofedD[OF _ rtrancl_path.base])
 
 lemma RF_circ_edge_forward:
   fixes \<Gamma> (structure)
   assumes x: "x \<in> RF\<^sup>\<circ> S"
   and edge: "edge \<Gamma> x y"
   shows "y \<in> RF S"
 proof
   fix p z
   assume p: "path \<Gamma> y p z" and z: "z \<in> B \<Gamma>"
   from x have rf: "x \<in> RF S" and ness: "x \<notin> \<E> S" by(auto elim: roofed_circE)
   show "(\<exists>z\<in>set p. z \<in> S) \<or> y \<in> S"
   proof(cases "\<exists>z'\<in>set (y # p). z' \<in> S")
     case False
     from edge p have p': "path \<Gamma> x (y # p) z" ..
     from roofedD[OF rf this z] False have "x \<in> S" by auto
     moreover have "essential \<Gamma> (B \<Gamma>) S x" using p' False z by(auto intro!: essentialI)
     ultimately have "x \<in> \<E> S" by simp
     with ness show ?thesis by contradiction
   qed auto
 qed
 
 subsection \<open>Waves\<close>
 
 inductive wave :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> bool"
   for \<Gamma> (structure) and f
 where
   wave:
   "\<lbrakk> separating \<Gamma> (TER f);
      \<And>x. x \<notin> RF (TER f) \<Longrightarrow> d_OUT f x = 0 \<rbrakk>
   \<Longrightarrow> wave \<Gamma> f"
 
 lemma wave_0 [simp]: "wave \<Gamma> zero_current"
 by rule simp_all
 
 lemma waveD_separating: "wave \<Gamma> f \<Longrightarrow> separating \<Gamma> (TER\<^bsub>\<Gamma>\<^esub> f)"
 by(simp add: wave.simps)
 
 lemma waveD_OUT: "\<lbrakk> wave \<Gamma> f; x \<notin> RF\<^bsub>\<Gamma>\<^esub> (TER\<^bsub>\<Gamma>\<^esub> f) \<rbrakk> \<Longrightarrow> d_OUT f x = 0"
 by(simp add: wave.simps)
 
 lemma wave_A_in_RF: fixes \<Gamma> (structure)
   shows "\<lbrakk> wave \<Gamma> f; x \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> x \<in> RF (TER f)"
 by(auto intro!: roofedI dest!: waveD_separating separatingD)
 
 lemma wave_not_RF_IN_zero:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and x: "x \<notin> RF (TER f)"
   shows "d_IN f x = 0"
 proof -
   from x obtain p z where z: "z \<in> B \<Gamma>" and p: "path \<Gamma> x p z"
     and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER f" "x \<notin> TER f"
     by(clarsimp simp add: roofed_def)
   have "f (y, x) = 0" for y
   proof(cases "edge \<Gamma> y x")
     case edge: True
     have "d_OUT f y = 0"
     proof(cases "y \<in> TER f")
       case False
       with z p bypass edge have "y \<notin> RF (TER f)"
         by(auto simp add: roofed_def intro: rtrancl_path.step intro!: exI rev_bexI)
       thus "d_OUT f y = 0" by(rule waveD_OUT[OF w])
     qed(auto simp add: SINK.simps)
     moreover have "f (y, x) \<le> d_OUT f y" by (rule d_OUT_ge_point)
     ultimately show ?thesis by simp
   qed(simp add: currentD_outside[OF f])
   then show "d_IN f x = 0" unfolding d_IN_def
     by(simp add: nn_integral_0_iff emeasure_count_space_eq_0)
 qed
 
 lemma current_Sup:
   fixes \<Gamma> (structure)
   assumes chain: "Complete_Partial_Order.chain (\<le>) Y"
   and Y: "Y \<noteq> {}"
   and current: "\<And>f. f \<in> Y \<Longrightarrow> current \<Gamma> f"
   and countable [simp]: "countable (support_flow (Sup Y))"
   shows "current \<Gamma> (Sup Y)"
 proof(rule, goal_cases)
   case (1 x)
   have "d_OUT (Sup Y) x = (SUP f\<in>Y. d_OUT f x)" using chain Y by(simp add: d_OUT_Sup)
   also have "\<dots> \<le> weight \<Gamma> x" using 1
     by(intro SUP_least)(auto dest!: current currentD_weight_OUT)
   finally show ?case .
 next
   case (2 x)
   have "d_IN (Sup Y) x = (SUP f\<in>Y. d_IN f x)" using chain Y by(simp add: d_IN_Sup)
   also have "\<dots> \<le> weight \<Gamma> x" using 2
     by(intro SUP_least)(auto dest!: current currentD_weight_IN)
   finally show ?case .
 next
   case (3 x)
   have "d_OUT (Sup Y) x = (SUP f\<in>Y. d_OUT f x)" using chain Y by(simp add: d_OUT_Sup)
   also have "\<dots> \<le> (SUP f\<in>Y. d_IN f x)" using 3
     by(intro SUP_mono)(auto dest: current currentD_OUT_IN)
   also have "\<dots> = d_IN (Sup Y) x" using chain Y by(simp add: d_IN_Sup)
   finally show ?case .
 next
   case (4 a)
   have "d_IN (Sup Y) a = (SUP f\<in>Y. d_IN f a)" using chain Y by(simp add: d_IN_Sup)
   also have "\<dots> = (SUP f\<in>Y. 0)" using 4 by(intro SUP_cong)(auto dest!: current currentD_IN)
   also have "\<dots> = 0" using Y by simp
   finally show ?case .
 next
   case (5 b)
   have "d_OUT (Sup Y) b = (SUP f\<in>Y. d_OUT f b)" using chain Y by(simp add: d_OUT_Sup)
   also have "\<dots> = (SUP f\<in>Y. 0)" using 5 by(intro SUP_cong)(auto dest!: current currentD_OUT)
   also have "\<dots> = 0" using Y by simp
   finally show ?case .
 next
   fix e
   assume "e \<notin> \<^bold>E"
   from currentD_outside'[OF current this] have "f e = 0" if "f \<in> Y" for f using that by simp
   hence "Sup Y e = (SUP _\<in>Y. 0)" by(auto intro: SUP_cong)
   then show "Sup Y e = 0" using Y by(simp)
 qed
 
 lemma wave_lub: \<comment> \<open>Lemma 4.3\<close>
   fixes \<Gamma> (structure)
   assumes chain: "Complete_Partial_Order.chain (\<le>) Y"
   and Y: "Y \<noteq> {}"
   and wave: "\<And>f. f \<in> Y \<Longrightarrow> wave \<Gamma> f"
   and countable [simp]: "countable (support_flow (Sup Y))"
   shows "wave \<Gamma> (Sup Y)"
 proof
   { fix x y p
     assume p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
     define P where "P = {x} \<union> set p"
 
     let ?f = "\<lambda>f. SINK f \<inter> P"
     have "Complete_Partial_Order.chain (\<supseteq>) (?f ` Y)" using chain
       by(rule chain_imageI)(auto dest: SINK_mono')
     moreover have "\<dots> \<subseteq> Pow P" by auto
     hence "finite (?f ` Y)" by(rule finite_subset)(simp add: P_def)
     ultimately have "(\<Inter>(?f ` Y)) \<in> ?f ` Y"
       by(rule ccpo.in_chain_finite[OF complete_lattice_ccpo_dual])(simp add: Y)
     then obtain f where f: "f \<in> Y" and eq: "\<Inter>(?f ` Y) = ?f f" by clarify
     hence *: "(\<Inter>f\<in>Y. SINK f) \<inter> P = SINK f \<inter> P" by(clarsimp simp add: prod_lub_def Y)+
     { fix g
       assume "g \<in> Y" "f \<le> g"
       with * have "(\<Inter>f\<in>Y. SINK f) \<inter> P = SINK g \<inter> P" by(blast dest: SINK_mono')
       then have "TER (Sup Y) \<inter> P \<supseteq> TER g \<inter> P"
         using SAT_Sup_upper[OF \<open>g \<in> Y\<close>, of \<Gamma>] SINK_Sup[OF chain Y countable] by blast }
     with f have "\<exists>f\<in>Y. \<forall>g\<in>Y. g \<ge> f \<longrightarrow> TER g \<inter> P \<subseteq> TER (Sup Y) \<inter> P" by blast }
   note subset = this
 
   show "separating \<Gamma> (TER (Sup Y))"
   proof
     fix x y p
     assume *: "path \<Gamma> x p y" "y \<in> B \<Gamma>" and "x \<in> A \<Gamma>"
     let ?P = "{x} \<union> set p"
     from subset[OF *] obtain f where f:"f \<in> Y"
       and subset: "TER f \<inter> ?P \<subseteq> TER (Sup Y) \<inter> ?P" by blast
     from wave[OF f] have "TER f \<inter> ?P \<noteq> {}" using * \<open>x \<in> A \<Gamma>\<close>
       by(auto simp add: wave.simps dest: separatingD)
     with subset show " (\<exists>z\<in>set p. z \<in> TER (Sup Y)) \<or> x \<in> TER (Sup Y)" by blast
   qed
 
   fix x
   assume "x \<notin> RF (TER (Sup Y))"
   then obtain p y where y: "y \<in> B \<Gamma>"
     and p: "path \<Gamma> x p y"
     and ter: "TER (Sup Y) \<inter> ({x} \<union> set p) = {}" by(auto simp add: roofed_def)
   let ?P = "{x} \<union> set p"
   from subset[OF p y] obtain f where f: "f \<in> Y"
     and subset: "\<And>g. \<lbrakk> g \<in> Y; f \<le> g \<rbrakk> \<Longrightarrow> TER g \<inter> ?P \<subseteq> TER (Sup Y) \<inter> ?P" by blast
 
   { fix g
     assume g: "g \<in> Y"
     with chain f have "f \<le> g \<or> g \<le> f" by(rule chainD)
     hence "d_OUT g x = 0"
     proof
       assume "f \<le> g"
       from subset[OF g this] ter have "TER g \<inter> ?P = {}" by blast
       with p y have "x \<notin> RF (TER g)" by(auto simp add: roofed_def)
       with wave[OF g] show ?thesis by(blast elim: wave.cases)
     next
       assume "g \<le> f"
       from subset ter f have "TER f \<inter> ?P = {}" by blast
       with y p have "x \<notin> RF (TER f)" by(auto simp add: roofed_def)
       with wave[OF f] have "d_OUT f x = 0" by(blast elim: wave.cases)
       moreover have "d_OUT g x \<le> d_OUT f x" using \<open>g \<le> f\<close>[THEN le_funD] by(rule d_OUT_mono)
       ultimately show ?thesis by simp
     qed }
   thus "d_OUT (Sup Y) x = 0" using chain Y by(simp add: d_OUT_Sup)
 qed
 
 lemma ex_maximal_wave: \<comment> \<open>Corollary 4.4\<close>
   fixes \<Gamma> (structure)
   assumes countable: "countable \<^bold>E"
   shows "\<exists>f. current \<Gamma> f \<and> wave \<Gamma> f \<and> (\<forall>w. current \<Gamma> w \<and> wave \<Gamma> w \<and> f \<le> w \<longrightarrow> f = w)"
 proof -
   define Field_r where "Field_r = {f. current \<Gamma> f \<and> wave \<Gamma> f}"
   define r where "r = {(f, g). f \<in> Field_r \<and> g \<in> Field_r \<and> f \<le> g}"
   have Field_r: "Field r = Field_r" by(auto simp add: Field_def r_def)
 
   have "Partial_order r" unfolding order_on_defs
     by(auto intro!: refl_onI transI antisymI simp add: Field_r r_def Field_def)
   hence "\<exists>m\<in>Field r. \<forall>a\<in>Field r. (m, a) \<in> r \<longrightarrow> a = m"
   proof(rule Zorns_po_lemma)
     fix Y
     assume "Y \<in> Chains r"
     hence Y: "Complete_Partial_Order.chain (\<le>) Y"
       and w: "\<And>f. f \<in> Y \<Longrightarrow> wave \<Gamma> f"
       and f: "\<And>f. f \<in> Y \<Longrightarrow> current \<Gamma> f"
       by(auto simp add: Chains_def r_def chain_def Field_r_def)
     show "\<exists>w \<in> Field r. \<forall>f \<in> Y. (f, w) \<in> r"
     proof(cases "Y = {}")
       case True
       have "zero_current \<in> Field r" by(simp add: Field_r Field_r_def)
       with True show ?thesis by blast
     next
       case False
       have "support_flow (Sup Y) \<subseteq> \<^bold>E" by(auto simp add: support_flow_Sup elim!: support_flow.cases dest!: f dest: currentD_outside)
       hence c: "countable (support_flow (Sup Y))" using countable  by(rule countable_subset)
       with Y False f w have "Sup Y \<in> Field r" unfolding Field_r Field_r_def
         by(blast intro: wave_lub current_Sup)
       moreover then have "(f, Sup Y) \<in> r" if "f \<in> Y" for f using w[OF that] f[OF that] that unfolding Field_r
         by(auto simp add: r_def Field_r_def intro: Sup_upper)
       ultimately show ?thesis by blast
     qed
   qed
   thus ?thesis by(simp add: Field_r Field_r_def)(auto simp add: r_def Field_r_def)
 qed
 
 lemma essential_leI:
   fixes \<Gamma> (structure)
   assumes g: "current \<Gamma> g" and w: "wave \<Gamma> g"
   and le: "\<And>e. f e \<le> g e"
   and x: "x \<in> \<E> (TER g)"
   shows "essential \<Gamma> (B \<Gamma>) (TER f) x"
 proof -
   from x obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and distinct: "distinct (x # p)"
     and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER g)" by(rule \<E>_E_RF) blast
   show ?thesis using p y
   proof
     fix z
     assume "z \<in> set p"
     hence z: "z \<notin> RF (TER g)" by(auto dest: bypass)
     with w have OUT: "d_OUT g z = 0" and IN: "d_IN g z = 0" by(rule waveD_OUT wave_not_RF_IN_zero[OF g])+
     with z have "z \<notin> A \<Gamma>" "weight \<Gamma> z > 0" by(auto intro!: roofed_greaterI simp add: SAT.simps SINK.simps)
     moreover from IN d_IN_mono[of f z g, OF le] have "d_IN f z \<le> 0" by(simp)
     ultimately have "z \<notin> TER f" by(auto simp add: SAT.simps)
     then show "z = x \<or> z \<notin> TER f" by simp
   qed
 qed
 
 lemma essential_eq_leI:
   fixes \<Gamma> (structure)
   assumes g: "current \<Gamma> g" and w: "wave \<Gamma> g"
   and le: "\<And>e. f e \<le> g e"
   and subset: "\<E> (TER g) \<subseteq> TER f"
   shows "\<E> (TER f) = \<E> (TER g)"
 proof
   show subset: "\<E> (TER g) \<subseteq> \<E> (TER f)"
   proof
     fix x
     assume x: "x \<in> \<E> (TER g)"
     hence "x \<in> TER f" using subset by blast
     moreover have "essential \<Gamma> (B \<Gamma>) (TER f) x" using g w le x by(rule essential_leI)
     ultimately show "x \<in> \<E> (TER f)" by simp
   qed
 
   show "\<dots> \<subseteq> \<E> (TER g)"
   proof
     fix x
     assume x: "x \<in> \<E> (TER f)"
     hence "x \<in> TER f" by auto
     hence "x \<in> RF (TER g)"
     proof(rule contrapos_pp)
       assume x: "x \<notin> RF (TER g)"
       with w have OUT: "d_OUT g x = 0" and IN: "d_IN g x = 0" by(rule waveD_OUT wave_not_RF_IN_zero[OF g])+
       with x have "x \<notin> A \<Gamma>" "weight \<Gamma> x > 0" by(auto intro!: roofed_greaterI simp add: SAT.simps SINK.simps)
       moreover from IN d_IN_mono[of f x g, OF le] have "d_IN f x \<le> 0" by(simp)
       ultimately show "x \<notin> TER f" by(auto simp add: SAT.simps)
     qed
     moreover have "x \<notin> RF\<^sup>\<circ> (TER g)"
     proof
       assume "x \<in> RF\<^sup>\<circ> (TER g)"
       hence RF: "x \<in> RF (\<E> (TER g))" and not_E: "x \<notin> \<E> (TER g)"
         unfolding RF_essential by(simp_all add: roofed_circ_def)
       from x obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and distinct: "distinct (x # p)"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)" by(rule \<E>_E_RF) blast
       from roofedD[OF RF p y] not_E obtain z where "z \<in> set p" "z \<in> \<E> (TER g)" by blast
       with subset bypass[of z] show False by(auto intro: roofed_greaterI)
     qed
     ultimately show "x \<in> \<E> (TER g)" by(simp add: roofed_circ_def)
   qed
 qed
 
 subsection \<open>Hindrances and looseness\<close>
 
 inductive hindrance_by :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> ennreal \<Rightarrow> bool"
   for \<Gamma> (structure) and f and \<epsilon>
 where
   hindrance_by:
   "\<lbrakk> a \<in> A \<Gamma>; a \<notin> \<E> (TER f); d_OUT f a < weight \<Gamma> a; \<epsilon> < weight \<Gamma> a - d_OUT f a \<rbrakk> \<Longrightarrow> hindrance_by \<Gamma> f \<epsilon>"
 
 inductive hindrance :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> bool"
   for \<Gamma> (structure) and f
 where
   hindrance:
   "\<lbrakk> a \<in> A \<Gamma>; a \<notin> \<E> (TER f); d_OUT f a < weight \<Gamma> a \<rbrakk> \<Longrightarrow> hindrance \<Gamma> f"
 
 inductive hindered :: "('v, 'more) web_scheme \<Rightarrow> bool"
   for \<Gamma> (structure)
 where hindered: "\<lbrakk> hindrance \<Gamma> f; current \<Gamma> f; wave \<Gamma> f \<rbrakk> \<Longrightarrow> hindered \<Gamma>"
 
 inductive hindered_by :: "('v, 'more) web_scheme \<Rightarrow> ennreal \<Rightarrow> bool"
   for \<Gamma> (structure) and \<epsilon>
 where hindered_by: "\<lbrakk> hindrance_by \<Gamma> f \<epsilon>; current \<Gamma> f; wave \<Gamma> f \<rbrakk> \<Longrightarrow> hindered_by \<Gamma> \<epsilon>"
 
 lemma hindrance_into_hindrance_by:
   assumes "hindrance \<Gamma> f"
   shows "\<exists>\<epsilon>>0. hindrance_by \<Gamma> f \<epsilon>"
 using assms
 proof cases
   case (hindrance a)
   let ?\<epsilon> = "if weight \<Gamma> a = \<top> then 1 else (weight \<Gamma> a - d_OUT f a) / 2"
   from \<open>d_OUT f a < weight \<Gamma> a\<close> have "weight \<Gamma> a - d_OUT f a > 0" "weight \<Gamma> a \<noteq> \<top> \<Longrightarrow> weight \<Gamma> a - d_OUT f a < \<top>"
     by(simp_all add: diff_gr0_ennreal less_top diff_less_top_ennreal)
   from ennreal_mult_strict_left_mono[of 1 2, OF _ this]
   have "0 < ?\<epsilon>" and "?\<epsilon> < weight \<Gamma> a - d_OUT f a" using \<open>d_OUT f a < weight \<Gamma> a\<close>
     by(auto intro!: diff_gr0_ennreal simp: ennreal_zero_less_divide divide_less_ennreal)
   with hindrance show ?thesis by(auto intro!: hindrance_by.intros)
 qed
 
 lemma hindrance_by_into_hindrance: "hindrance_by \<Gamma> f \<epsilon> \<Longrightarrow> hindrance \<Gamma> f"
 by(blast elim: hindrance_by.cases intro: hindrance.intros)
 
 lemma hindrance_conv_hindrance_by: "hindrance \<Gamma> f \<longleftrightarrow> (\<exists>\<epsilon>>0. hindrance_by \<Gamma> f \<epsilon>)"
 by(blast intro: hindrance_into_hindrance_by hindrance_by_into_hindrance)
 
 lemma hindered_into_hindered_by: "hindered \<Gamma> \<Longrightarrow> \<exists>\<epsilon>>0. hindered_by \<Gamma> \<epsilon>"
 by(blast intro: hindered_by.intros elim: hindered.cases dest: hindrance_into_hindrance_by)
 
 lemma hindered_by_into_hindered: "hindered_by \<Gamma> \<epsilon> \<Longrightarrow> hindered \<Gamma>"
 by(blast elim: hindered_by.cases intro: hindered.intros dest: hindrance_by_into_hindrance)
 
 lemma hindered_conv_hindered_by: "hindered \<Gamma> \<longleftrightarrow> (\<exists>\<epsilon>>0. hindered_by \<Gamma> \<epsilon>)"
 by(blast intro: hindered_into_hindered_by hindered_by_into_hindered)
 
 inductive loose :: "('v, 'more) web_scheme \<Rightarrow> bool"
   for \<Gamma>
 where
   loose: "\<lbrakk> \<And>f. \<lbrakk> current \<Gamma> f; wave \<Gamma> f \<rbrakk> \<Longrightarrow> f = zero_current; \<not> hindrance \<Gamma> zero_current \<rbrakk>
   \<Longrightarrow> loose \<Gamma>"
 
 lemma looseD_hindrance: "loose \<Gamma> \<Longrightarrow> \<not> hindrance \<Gamma> zero_current"
 by(simp add: loose.simps)
 
 lemma looseD_wave:
   "\<lbrakk> loose \<Gamma>; current \<Gamma> f; wave \<Gamma> f \<rbrakk> \<Longrightarrow> f = zero_current"
 by(simp add: loose.simps)
 
 lemma loose_unhindered:
   fixes \<Gamma> (structure)
   assumes "loose \<Gamma>"
   shows "\<not> hindered \<Gamma>"
 apply auto
   apply(erule hindered.cases)
 apply(frule (1) looseD_wave[OF assms])
 apply simp
 using looseD_hindrance[OF assms]
 by simp
 
 context
   fixes \<Gamma> \<Gamma>' :: "('v, 'more) web_scheme"
   assumes [simp]: "edge \<Gamma> = edge \<Gamma>'" "A \<Gamma> = A \<Gamma>'" "B \<Gamma> = B \<Gamma>'"
   and weight_eq: "\<And>x. x \<notin> A \<Gamma>' \<Longrightarrow> weight \<Gamma> x = weight \<Gamma>' x"
   and weight_le: "\<And>a. a \<in> A \<Gamma>' \<Longrightarrow> weight \<Gamma> a \<ge> weight \<Gamma>' a"
 begin
 
 private lemma essential_eq: "essential \<Gamma> = essential \<Gamma>'"
 by(simp add: fun_eq_iff essential_def)
 
 qualified lemma TER_eq: "TER\<^bsub>\<Gamma>\<^esub> f = TER\<^bsub>\<Gamma>'\<^esub> f"
 apply(auto simp add: SINK.simps SAT.simps)
 apply(erule contrapos_np; drule weight_eq; simp)+
 done
 
 qualified lemma separating_eq: "separating_gen \<Gamma> = separating_gen \<Gamma>'"
 by(intro ext iffI; rule separating_gen.intros; drule separatingD; simp)
 
 qualified lemma roofed_eq: "\<And>B. roofed_gen \<Gamma> B S = roofed_gen \<Gamma>' B S"
 by(simp add: roofed_def)
 
 lemma wave_eq_web: \<comment> \<open>Observation 4.6\<close>
   "wave \<Gamma> f \<longleftrightarrow> wave \<Gamma>' f"
 by(simp add: wave.simps separating_eq TER_eq roofed_eq)
 
 lemma current_mono_web: "current \<Gamma>' f \<Longrightarrow> current \<Gamma> f"
 apply(rule current, simp_all add: currentD_OUT_IN currentD_IN currentD_OUT  currentD_outside')
 subgoal for x by(cases "x \<in> A \<Gamma>'")(auto dest!: weight_eq weight_le dest: currentD_weight_OUT intro: order_trans)
 subgoal for x by(cases "x \<in> A \<Gamma>'")(auto dest!: weight_eq weight_le dest: currentD_weight_IN intro: order_trans)
 done
 
 lemma hindrance_mono_web: "hindrance \<Gamma>' f \<Longrightarrow> hindrance \<Gamma> f"
 apply(erule hindrance.cases)
 apply(rule hindrance)
   apply simp
  apply(unfold TER_eq, simp add: essential_eq)
 apply(auto dest!: weight_le)
 done
 
 lemma hindered_mono_web: "hindered \<Gamma>' \<Longrightarrow> hindered \<Gamma>"
 apply(erule hindered.cases)
 apply(rule hindered.intros)
   apply(erule hindrance_mono_web)
  apply(erule current_mono_web)
 apply(simp add: wave_eq_web)
 done
 
 end
 
 subsection \<open>Linkage\<close>
 
 text \<open>
   The following definition of orthogonality is stronger than the original definition 3.5 in
   @{cite AharoniBergerGeorgakopoulusPerlsteinSpruessel2011JCT} in that the outflow from any
   \<open>A\<close>-vertices in the set must saturate the vertex; @{term "S \<subseteq> SAT \<Gamma> f"} is not enough.
 
   With the original definition of orthogonal current, the reduction from networks to webs fails because
   the induced flow need not saturate edges going out of the source. Consider the network with three
   nodes \<open>s\<close>, \<open>x\<close>, and \<open>t\<close> and edges \<open>(s, x)\<close> and \<open>(x, t)\<close> with
   capacity \<open>1\<close>. Then, the corresponding web has the vertices \<open>(s, x)\<close> and
   \<open>(x, t)\<close> and one edge from \<open>(s, x)\<close> to \<open>(x, t)\<close>. Clearly, the zero current
   @{term [source] zero_current} is a web-flow and \<open>TER zero_current = {(s, x)}\<close>, which is essential.
   Moreover, @{term [source] zero_current} and \<open>{(s, x)}\<close> are orthogonal because
   @{term [source] zero_current} trivially saturates \<open>(s, x)\<close> as this is a vertex in \<open>A\<close>.
 \<close>
 inductive orthogonal_current :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v set \<Rightarrow> bool"
   for \<Gamma> (structure) and f S
 where orthogonal_current:
   "\<lbrakk> \<And>x. \<lbrakk> x \<in> S; x \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> weight \<Gamma> x \<le> d_IN f x;
      \<And>x. \<lbrakk> x \<in> S; x \<in> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f x = weight \<Gamma> x;
     \<And>u v. \<lbrakk> v \<in> RF S; u \<notin> RF\<^sup>\<circ> S \<rbrakk> \<Longrightarrow> f (u, v) = 0 \<rbrakk>
   \<Longrightarrow> orthogonal_current \<Gamma> f S"
 
 lemma orthogonal_currentD_SAT: "\<lbrakk> orthogonal_current \<Gamma> f S; x \<in> S \<rbrakk> \<Longrightarrow> x \<in> SAT \<Gamma> f"
 by(auto elim!: orthogonal_current.cases intro: SAT.intros)
 
 lemma orthogonal_currentD_A: "\<lbrakk> orthogonal_current \<Gamma> f S; x \<in> S; x \<in> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f x = weight \<Gamma> x"
 by(auto elim: orthogonal_current.cases)
 
 lemma orthogonal_currentD_in: "\<lbrakk> orthogonal_current \<Gamma> f S; v \<in> RF\<^bsub>\<Gamma>\<^esub> S; u \<notin> RF\<^sup>\<circ>\<^bsub>\<Gamma>\<^esub> S \<rbrakk> \<Longrightarrow> f (u, v) = 0"
 by(auto elim: orthogonal_current.cases)
 
 inductive linkage :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> bool"
   for \<Gamma> f
 where \<comment> \<open>Omit the condition @{const web_flow}\<close>
   linkage: "(\<And>x. x \<in> A \<Gamma> \<Longrightarrow> d_OUT f x = weight \<Gamma> x) \<Longrightarrow> linkage \<Gamma> f"
 
 lemma linkageD: "\<lbrakk> linkage \<Gamma> f; x \<in> A \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f x = weight \<Gamma> x"
 by(rule linkage.cases)
 
 abbreviation linkable :: "('v, 'more) web_scheme \<Rightarrow> bool"
 where "linkable \<Gamma> \<equiv> \<exists>f. web_flow \<Gamma> f \<and> linkage \<Gamma> f"
 
 subsection \<open>Trimming\<close>
 
 context
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure)
   and f :: "'v current"
 begin
 
 inductive trimming :: "'v current \<Rightarrow> bool"
   for g
 where
   trimming:
   \<comment> \<open>omits the condition that @{term f} is a wave\<close>
   "\<lbrakk> current \<Gamma> g; wave \<Gamma> g; g \<le> f; \<And>x. \<lbrakk> x \<in> RF\<^sup>\<circ> (TER f); x \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> KIR g x; \<E> (TER g) - A \<Gamma> = \<E> (TER f) - A \<Gamma> \<rbrakk>
   \<Longrightarrow> trimming g"
 
 lemma assumes "trimming g"
   shows trimmingD_current: "current \<Gamma> g"
   and trimmingD_wave: "wave \<Gamma> g"
   and trimmingD_le: "\<And>e. g e \<le> f e"
   and trimmingD_KIR: "\<lbrakk> x \<in> RF\<^sup>\<circ> (TER f); x \<notin> A \<Gamma> \<rbrakk> \<Longrightarrow> KIR g x"
   and trimmingD_\<E>: "\<E> (TER g) - A \<Gamma> = \<E> (TER f) - A \<Gamma>"
 using assms by(blast elim: trimming.cases dest: le_funD)+
 
 lemma ex_trimming: \<comment> \<open>Lemma 4.8\<close>
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and countable: "countable \<^bold>E"
   and weight_finite: "\<And>x. weight \<Gamma> x \<noteq> \<top>"
   shows "\<exists>g. trimming g"
 proof -
   define F where "F = {g. current \<Gamma> g \<and> wave \<Gamma> g \<and> g \<le> f \<and> \<E> (TER g) = \<E> (TER f)}"
   define leq where "leq = restrict_rel F {(g, g'). g' \<le> g}"
   have in_F [simp]: "g \<in> F \<longleftrightarrow> current \<Gamma> g \<and> wave \<Gamma> g \<and> (\<forall>e. g e \<le> f e) \<and> \<E> (TER g) = \<E> (TER f)" for g
     by(simp add: F_def le_fun_def)
 
   have f_finite [simp]: "f e \<noteq> \<top>" for e
   proof(cases e)
     case (Pair x y)
     have "f (x, y) \<le> d_IN f y" by (rule d_IN_ge_point)
     also have "\<dots> \<le> weight \<Gamma> y" by(rule currentD_weight_IN[OF f])
     also have "\<dots> < \<top>" by(simp add: weight_finite less_top[symmetric])
     finally show ?thesis using Pair by simp
   qed
 
   have chainD: "Inf M \<in> F" if M: "M \<in> Chains leq" and nempty: "M \<noteq> {}" for M
   proof -
     from nempty obtain g0 where g0: "g0 \<in> M" by auto
     have g0_le_f: "g0 e \<le> f e" and g: "current \<Gamma> g0" and w0: "wave \<Gamma> g0" for e
       using Chains_FieldD[OF M g0] by(cases e, auto simp add: leq_def)
 
     have finite_OUT: "d_OUT f x \<noteq> \<top>" for x using weight_finite[of x]
       by(rule neq_top_trans)(rule currentD_weight_OUT[OF f])
     have finite_IN: "d_IN f x \<noteq> \<top>" for x using weight_finite[of x]
       by(rule neq_top_trans)(rule currentD_weight_IN[OF f])
 
     from M have "M \<in> Chains {(g, g'). g' \<le> g}"
       by(rule mono_Chains[THEN subsetD, rotated])(auto simp add: leq_def in_restrict_rel_iff)
     then have chain: "Complete_Partial_Order.chain (\<ge>) M" by(rule Chains_into_chain)
     hence chain': "Complete_Partial_Order.chain (\<le>) M" by(simp add: chain_dual)
 
     have countable': "countable (support_flow f)"
       using current_support_flow[OF f] by(rule countable_subset)(rule countable)
 
     have OUT_M: "d_OUT (Inf M) x = (INF g\<in>M. d_OUT g x)" for x using chain' nempty countable' _ finite_OUT
       by(rule d_OUT_Inf)(auto dest!: Chains_FieldD[OF M]  simp add: leq_def)
     have IN_M: "d_IN (Inf M) x = (INF g\<in>M. d_IN g x)" for x using chain' nempty countable' _ finite_IN
       by(rule d_IN_Inf)(auto dest!: Chains_FieldD[OF M]  simp add: leq_def)
 
     have c: "current \<Gamma> (Inf M)" using g
     proof(rule current_leI)
       show "(Inf M) e \<le> g0 e" for e using g0 by(auto intro: INF_lower)
       show "d_OUT (\<Sqinter>M) x \<le> d_IN (\<Sqinter>M) x" if "x \<notin> A \<Gamma>" for x
         by(auto 4 4 simp add: IN_M OUT_M leq_def intro!: INF_mono dest: Chains_FieldD[OF M] intro: currentD_OUT_IN[OF _ that])
     qed
 
     have INF_le_f: "Inf M e \<le> f e" for e using g0 by(auto intro!: INF_lower2 g0_le_f)
     have eq: "\<E> (TER (Inf M)) = \<E> (TER f)" using f w INF_le_f
     proof(rule essential_eq_leI; intro subsetI)
       fix x
       assume x: "x \<in> \<E> (TER f)"
       hence "x \<in> SINK (Inf M)" using d_OUT_mono[of "Inf M" x f, OF INF_le_f]
         by(auto simp add: SINK.simps)
       moreover from x have "x \<in> SAT \<Gamma> g" if "g \<in> M" for g using Chains_FieldD[OF M that] by(auto simp add: leq_def)
       hence "x \<in> SAT \<Gamma> (Inf M)" by(auto simp add: SAT.simps IN_M intro!: INF_greatest)
       ultimately show "x \<in> TER (Inf M)" by auto
     qed
 
     have w': "wave \<Gamma> (Inf M)"
     proof
       have "separating \<Gamma> (\<E> (TER f))" by(rule separating_essential)(rule waveD_separating[OF w])
       then show "separating \<Gamma> (TER (Inf M))" unfolding eq[symmetric] by(rule separating_weakening) auto
 
       fix x
       assume "x \<notin> RF (TER (Inf M))"
       hence "x \<notin> RF (\<E> (TER (Inf M)))" unfolding RF_essential .
       hence "x \<notin> RF (TER f)" unfolding eq RF_essential .
       hence "d_OUT f x = 0" by(rule waveD_OUT[OF w])
       with d_OUT_mono[of _ x f, OF INF_le_f]
       show "d_OUT (Inf M) x = 0" by (metis le_zero_eq)
     qed
     from c w' INF_le_f eq show ?thesis by simp
   qed
 
   define trim1
     where "trim1 g =
       (if trimming g then g
         else let z = SOME z. z \<in> RF\<^sup>\<circ> (TER g) \<and> z \<notin> A \<Gamma> \<and> \<not> KIR g z;
             factor = d_OUT g z / d_IN g z
           in (\<lambda>(y, x). (if x = z then factor else 1) * g (y, x)))" for g
 
   have increasing: "trim1 g \<le> g \<and> trim1 g \<in> F" if "g \<in> F" for g
   proof(cases "trimming g")
     case True
     thus ?thesis using that by(simp add: trim1_def)
   next
     case False
     let ?P = "\<lambda>z. z \<in> RF\<^sup>\<circ> (TER g) \<and> z \<notin> A \<Gamma> \<and> \<not> KIR g z"
     define z where "z = Eps ?P"
     from that have g: "current \<Gamma> g" and w': "wave \<Gamma> g" and le_f: "\<And>e. g e \<le> f e"
       and \<E>: "\<E> (TER g) = \<E> (TER f)" by(auto simp add: le_fun_def)
     { with False obtain z where z: "z \<in> RF\<^sup>\<circ> (TER f)" and A: "z \<notin> A \<Gamma>" and neq: "d_OUT g z \<noteq> d_IN g z"
         by(auto simp add: trimming.simps le_fun_def)
       from z have "z \<in> RF\<^sup>\<circ> (\<E> (TER f))" unfolding roofed_circ_essential .
       with \<E> roofed_circ_essential[of \<Gamma> "TER g"] have "z \<in> RF\<^sup>\<circ> (TER g)" by simp
       with A neq have "\<exists>x. ?P x" by auto }
     hence "?P z" unfolding z_def by(rule someI_ex)
     hence RF: "z \<in> RF\<^sup>\<circ> (TER g)" and A: "z \<notin> A \<Gamma>" and neq: "d_OUT g z \<noteq> d_IN g z" by simp_all
     let ?factor = "d_OUT g z / d_IN g z"
     have trim1 [simp]: "trim1 g (y, x) = (if x = z then ?factor else 1) * g (y, x)" for x y
       using False by(auto simp add: trim1_def z_def Let_def)
 
     from currentD_OUT_IN[OF g A] neq have less: "d_OUT g z < d_IN g z" by auto
     hence "?factor \<le> 1" (is "?factor \<le> _")
       by (auto intro!: divide_le_posI_ennreal simp: zero_less_iff_neq_zero)
     hence le': "?factor * g (y, x) \<le> 1 * g (y, x)" for y x
       by(rule mult_right_mono) simp
     hence le: "trim1 g e \<le> g e" for e by(cases e)simp
     moreover {
       have c: "current \<Gamma> (trim1 g)" using g le
       proof(rule current_leI)
         fix x
         assume x: "x \<notin> A \<Gamma>"
         have "d_OUT (trim1 g) x \<le> d_OUT g x" unfolding d_OUT_def using le' by(auto intro: nn_integral_mono)
         also have "\<dots> \<le> d_IN (trim1 g) x"
         proof(cases "x = z")
           case True
           have "d_OUT g x = d_IN (trim1 g) x" unfolding d_IN_def
             using True currentD_weight_IN[OF g, of x] currentD_OUT_IN[OF g x]
             apply (cases "d_IN g x = 0")
             apply(auto simp add: nn_integral_divide nn_integral_cmult d_IN_def[symmetric] ennreal_divide_times)
             apply (subst ennreal_divide_self)
             apply (auto simp: less_top[symmetric] top_unique weight_finite)
             done
           thus ?thesis by simp
         next
           case False
           have "d_OUT g x \<le> d_IN g x" using x by(rule currentD_OUT_IN[OF g])
           also have "\<dots> \<le> d_IN (trim1 g) x" unfolding d_IN_def using False by(auto intro!: nn_integral_mono)
           finally show ?thesis .
         qed
         finally show "d_OUT (trim1 g) x \<le> d_IN (trim1 g) x" .
       qed
       moreover have le_f: "trim1 g \<le> f" using le le_f by(blast intro: le_funI order_trans)
       moreover have eq: "\<E> (TER (trim1 g)) = \<E> (TER f)" unfolding \<E>[symmetric] using g w' le
       proof(rule essential_eq_leI; intro subsetI)
         fix x
         assume x: "x \<in> \<E> (TER g)"
         hence "x \<in> SINK (trim1 g)" using d_OUT_mono[of "trim1 g" x g, OF le]
           by(auto simp add: SINK.simps)
         moreover from x have "x \<noteq> z" using RF by(auto simp add: roofed_circ_def)
         hence "d_IN (trim1 g) x = d_IN g x" unfolding d_IN_def by simp
         with \<open>x \<in> \<E> (TER g)\<close> have "x \<in> SAT \<Gamma> (trim1 g)" by(auto simp add: SAT.simps)
         ultimately show "x \<in> TER (trim1 g)" by auto
       qed
       moreover have "wave \<Gamma> (trim1 g)"
       proof
         have "separating \<Gamma> (\<E> (TER f))" by(rule separating_essential)(rule waveD_separating[OF w])
         then show "separating \<Gamma> (TER (trim1 g))" unfolding eq[symmetric] by(rule separating_weakening) auto
 
         fix x
         assume "x \<notin> RF (TER (trim1 g))"
         hence "x \<notin> RF (\<E> (TER (trim1 g)))" unfolding RF_essential .
         hence "x \<notin> RF (TER f)" unfolding eq RF_essential .
         hence "d_OUT f x = 0" by(rule waveD_OUT[OF w])
         with d_OUT_mono[of _ x f, OF le_f[THEN le_funD]]
         show "d_OUT (trim1 g) x = 0" by (metis le_zero_eq)
       qed
       ultimately have "trim1 g \<in> F" by(simp add: F_def) }
     ultimately show ?thesis using that by(simp add: le_fun_def del: trim1)
   qed
 
   have "bourbaki_witt_fixpoint Inf leq trim1" using chainD increasing unfolding leq_def
     by(intro bourbaki_witt_fixpoint_restrict_rel)(auto intro: Inf_greatest Inf_lower)
   then interpret bourbaki_witt_fixpoint Inf leq trim1 .
 
   have f_Field: "f \<in> Field leq" using f w by(simp add: leq_def)
 
   define g where "g = fixp_above f"
 
   have "g \<in> Field leq" using f_Field unfolding g_def by(rule fixp_above_Field)
   hence le_f: "g \<le> f"
     and g: "current \<Gamma> g"
     and w': "wave \<Gamma> g"
     and TER: "\<E> (TER g) = \<E> (TER f)" by(auto simp add: leq_def intro: le_funI)
 
   have "trimming g"
   proof(rule ccontr)
     let ?P = "\<lambda>x. x \<in> RF\<^sup>\<circ> (TER g) \<and> x \<notin> A \<Gamma> \<and> \<not> KIR g x"
     define x where "x = Eps ?P"
     assume False: "\<not> ?thesis"
     hence "\<exists>x. ?P x" using le_f g w' TER
       by(auto simp add: trimming.simps roofed_circ_essential[of \<Gamma> "TER g", symmetric] roofed_circ_essential[of \<Gamma> "TER f", symmetric])
     hence "?P x" unfolding x_def by(rule someI_ex)
     hence x: "x \<in> RF\<^sup>\<circ> (TER g)" and A: "x \<notin> A \<Gamma>" and neq: "d_OUT g x \<noteq> d_IN g x" by simp_all
     from neq have "\<exists>y. edge \<Gamma> y x \<and> g (y, x) > 0"
     proof(rule contrapos_np)
       assume "\<not> ?thesis"
       hence "d_IN g x = 0" using currentD_outside[OF g, of _ x]
         by(force simp add: d_IN_def nn_integral_0_iff_AE AE_count_space not_less)
       with currentD_OUT_IN[OF g A] show "KIR g x" by simp
     qed
     then obtain y where y: "edge \<Gamma> y x" and gr0: "g (y, x) > 0" by blast
 
     have [simp]: "g (y, x) \<noteq> \<top>"
     proof -
       have "g (y, x) \<le> d_OUT g y" by (rule d_OUT_ge_point)
       also have "\<dots> \<le> weight \<Gamma> y" by(rule currentD_weight_OUT[OF g])
       also have "\<dots> < \<top>" by(simp add: weight_finite less_top[symmetric])
       finally show ?thesis by simp
     qed
 
     from neq have factor: "d_OUT g x / d_IN g x \<noteq> 1"
       by (simp add: divide_eq_1_ennreal)
 
     have "trim1 g (y, x) = g (y, x) * (d_OUT g x / d_IN g x)"
       by(clarsimp simp add: False trim1_def Let_def x_def[symmetric] mult.commute)
     moreover have "\<dots> \<noteq> g (y, x) * 1" unfolding ennreal_mult_cancel_left using gr0 factor by auto
     ultimately have "trim1 g (y, x) \<noteq> g (y, x)" by auto
     hence "trim1 g \<noteq> g" by(auto simp add: fun_eq_iff)
     moreover have "trim1 g = g" using f_Field unfolding g_def by(rule fixp_above_unfold[symmetric])
     ultimately show False by contradiction
   qed
   then show ?thesis by blast
 qed
 
 end
 
 lemma trimming_\<E>:
   fixes \<Gamma> (structure)
   assumes w: "wave \<Gamma> f" and trimming: "trimming \<Gamma> f g"
   shows "\<E> (TER f) = \<E> (TER g)"
 proof(rule set_eqI)
   show "x \<in> \<E> (TER f) \<longleftrightarrow> x \<in> \<E> (TER g)" for x
   proof(cases "x \<in> A \<Gamma>")
     case False
     thus ?thesis using trimmingD_\<E>[OF trimming] by blast
   next
     case True
     show ?thesis
     proof
       assume x: "x \<in> \<E> (TER f)"
       hence "x \<in> TER g" using d_OUT_mono[of g x f, OF trimmingD_le[OF trimming]] True
         by(simp add: SINK.simps SAT.A)
       moreover from x have "essential \<Gamma> (B \<Gamma>) (TER f) x" by simp
       then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)" by(rule essentialE_RF) blast
       from p y have "essential \<Gamma> (B \<Gamma>) (\<E> (TER g)) x"
       proof(rule essentialI)
         fix z
         assume "z \<in> set p"
         hence z: "z \<notin> RF (TER f)" by(rule bypass)
         with waveD_separating[OF w, THEN separating_RF_A] have "z \<notin> A \<Gamma>" by blast
         with z have "z \<notin> \<E> (TER g)" using trimmingD_\<E>[OF trimming] by(auto intro: roofed_greaterI)
         thus "z = x \<or> z \<notin> \<E> (TER g)" ..
       qed
       ultimately show "x \<in> \<E> (TER g)" unfolding essential_\<E> by simp
     next
       assume "x \<in> \<E> (TER g)"
       then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER g)" by(rule \<E>_E_RF) blast
       have z: "z \<notin> \<E> (TER f)" if "z \<in> set p" for z
       proof -
         from that have z: "z \<notin> RF (TER g)" by(rule bypass)
         with waveD_separating[OF trimmingD_wave[OF trimming], THEN separating_RF_A] have "z \<notin> A \<Gamma>" by blast
         with z show "z \<notin> \<E> (TER f)" using trimmingD_\<E>[OF trimming] by(auto intro: roofed_greaterI)
       qed
       then have "essential \<Gamma> (B \<Gamma>) (\<E> (TER f)) x" by(intro essentialI[OF p y]) auto
       moreover have "x \<in> TER f"
         using waveD_separating[THEN separating_essential, THEN separatingD, OF w p True y] z
         by auto
       ultimately show "x \<in> \<E> (TER f)" unfolding essential_\<E> by simp
     qed
   qed
 qed
 
 subsection \<open>Composition of waves via quotients\<close>
 
 definition quotient_web :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> ('v, 'more) web_scheme"
 where \<comment> \<open>Modifications to original Definition 4.9: No incoming edges to nodes in @{const A},
   @{term "B \<Gamma> - A \<Gamma>"} is not part of @{const A} such that @{const A} contains only vertices
   is disjoint from @{const B}. The weight of vertices in @{const B} saturated by @{term f} is
   therefore set to @{term "0 :: ennreal"}.\<close>
   "quotient_web \<Gamma> f =
    \<lparr>edge = \<lambda>x y. edge \<Gamma> x y \<and> x \<notin> roofed_circ \<Gamma> (TER\<^bsub>\<Gamma>\<^esub> f) \<and> y \<notin> roofed \<Gamma> (TER\<^bsub>\<Gamma>\<^esub> f),
     weight = \<lambda>x. if x \<in> RF\<^sup>\<circ>\<^bsub>\<Gamma>\<^esub> (TER\<^bsub>\<Gamma>\<^esub> f) \<or> x \<in> TER\<^bsub>\<Gamma>\<^esub> f \<inter> B \<Gamma> then 0 else weight \<Gamma> x,
     A = \<E>\<^bsub>\<Gamma>\<^esub> (TER\<^bsub>\<Gamma>\<^esub> f) - (B \<Gamma> - A \<Gamma>),
     B = B \<Gamma>,
     \<dots> = web.more \<Gamma>\<rparr>"
 
 lemma quotient_web_sel [simp]:
   fixes \<Gamma> (structure) shows
   "edge (quotient_web \<Gamma> f) x y \<longleftrightarrow> edge \<Gamma> x y \<and> x \<notin> RF\<^sup>\<circ> (TER f) \<and> y \<notin> RF (TER f)"
   "weight (quotient_web \<Gamma> f) x = (if x \<in> RF\<^sup>\<circ> (TER f) \<or> x \<in> TER\<^bsub>\<Gamma>\<^esub> f \<inter> B \<Gamma> then 0 else weight \<Gamma> x)"
   "A (quotient_web \<Gamma> f) = \<E> (TER f)- (B \<Gamma> - A \<Gamma>)"
   "B (quotient_web \<Gamma> f) = B \<Gamma>"
   "web.more (quotient_web \<Gamma> f) = web.more \<Gamma>"
 by(simp_all add: quotient_web_def)
 
 lemma vertex_quotient_webD: fixes \<Gamma> (structure) shows
   "vertex (quotient_web \<Gamma> f) x \<Longrightarrow> vertex \<Gamma> x \<and> x \<notin> RF\<^sup>\<circ> (TER f)"
 by(auto simp add: vertex_def roofed_circ_def)
 
 lemma path_quotient_web:
   fixes \<Gamma> (structure)
   assumes "path \<Gamma> x p y"
   and "x \<notin> RF\<^sup>\<circ> (TER f)"
   and "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)"
   shows "path (quotient_web \<Gamma> f) x p y"
 using assms by(induction)(auto intro: rtrancl_path.intros simp add: roofed_circ_def)
 
 definition restrict_current :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v current \<Rightarrow> 'v current"
 where "restrict_current \<Gamma> f g = (\<lambda>(x, y). g (x, y) * indicator (- RF\<^sup>\<circ>\<^bsub>\<Gamma>\<^esub> (TER\<^bsub>\<Gamma>\<^esub> f)) x * indicator (- RF\<^bsub>\<Gamma>\<^esub> (TER\<^bsub>\<Gamma>\<^esub> f)) y)"
 
 abbreviation restrict_curr :: "'v current \<Rightarrow> ('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> 'v current" ("_ \<upharpoonleft> _ '/ _" [100, 0, 100] 100)
 where "restrict_curr g \<Gamma> f \<equiv> restrict_current \<Gamma> f g"
 
 lemma restrict_current_simps [simp]: fixes \<Gamma> (structure) shows
   "(g \<upharpoonleft> \<Gamma> / f) (x, y) = (g (x, y) * indicator (- RF\<^sup>\<circ> (TER f)) x * indicator (- RF (TER f)) y)"
 by(simp add: restrict_current_def)
 
 lemma d_OUT_restrict_current_outside: fixes \<Gamma> (structure) shows
   "x \<in> RF\<^sup>\<circ> (TER f) \<Longrightarrow> d_OUT (g \<upharpoonleft> \<Gamma> / f) x = 0"
 by(simp add: d_OUT_def)
 
 lemma d_IN_restrict_current_outside: fixes \<Gamma> (structure) shows
   "x \<in> RF (TER f) \<Longrightarrow> d_IN (g \<upharpoonleft> \<Gamma> / f) x = 0"
 by(simp add: d_IN_def)
 
 lemma restrict_current_le: "(g \<upharpoonleft> \<Gamma> / f) e \<le> g e"
 by(cases e)(clarsimp split: split_indicator)
 
 lemma d_OUT_restrict_current_le: "d_OUT (g \<upharpoonleft> \<Gamma> / f) x \<le> d_OUT g x"
 unfolding d_OUT_def by(rule nn_integral_mono, simp split: split_indicator)
 
 lemma d_IN_restrict_current_le: "d_IN (g \<upharpoonleft> \<Gamma> / f) x \<le> d_IN g x"
 unfolding d_IN_def by(rule nn_integral_mono, simp split: split_indicator)
 
 lemma restrict_current_IN_not_RF:
   fixes \<Gamma> (structure)
   assumes g: "current \<Gamma> g"
   and x: "x \<notin> RF (TER f)"
   shows "d_IN (g \<upharpoonleft> \<Gamma> / f) x = d_IN g x"
 proof -
   {
     fix y
     assume y: "y \<in> RF\<^sup>\<circ> (TER f)"
     have "g (y, x) = 0"
     proof(cases "edge \<Gamma> y x")
       case True
       from y have y': "y \<in> RF (TER f)" and essential: "y \<notin> \<E> (TER f)" by(simp_all add: roofed_circ_def)
       moreover from x obtain p z where z: "z \<in> B \<Gamma>" and p: "path \<Gamma> x p z"
         and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER f" "x \<notin> TER f"
         by(clarsimp simp add: roofed_def)
       from roofedD[OF y' rtrancl_path.step, OF True p z] bypass have "x \<in> TER f \<or> y \<in> TER f" by auto
       with roofed_greater[THEN subsetD, of x "TER f" \<Gamma>] x have "x \<notin> TER f" "y \<in> TER f" by auto
       with essential bypass have False
         by(auto dest!: not_essentialD[OF _ rtrancl_path.step, OF _ True p z])
       thus ?thesis ..
     qed(simp add: currentD_outside[OF g]) }
   then show ?thesis unfolding d_IN_def
     using x by(auto intro!: nn_integral_cong split: split_indicator)
 qed
 
 lemma restrict_current_IN_A:
   "a \<in> A (quotient_web \<Gamma> f) \<Longrightarrow> d_IN (g \<upharpoonleft> \<Gamma> / f) a = 0"
 by(simp add: d_IN_restrict_current_outside roofed_greaterI)
 
 lemma restrict_current_nonneg: "0 \<le> g e \<Longrightarrow> 0 \<le> (g \<upharpoonleft> \<Gamma> / f) e"
 by(cases e) simp
 
 lemma in_SINK_restrict_current: "x \<in> SINK g \<Longrightarrow> x \<in> SINK (g \<upharpoonleft> \<Gamma> / f)"
 using d_OUT_restrict_current_le[of \<Gamma> f g x]
 by(simp add: SINK.simps)
 
 lemma SAT_restrict_current:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and g: "current \<Gamma> g"
   shows "SAT (quotient_web \<Gamma> f) (g \<upharpoonleft> \<Gamma> / f) = RF (TER f) \<union> (SAT \<Gamma> g - A \<Gamma>)" (is "SAT ?\<Gamma> ?g = ?rhs")
 proof(intro set_eqI iffI; (elim UnE DiffE)?)
   show "x \<in> ?rhs" if "x \<in> SAT ?\<Gamma> ?g" for x using that
   proof cases
     case IN
     thus ?thesis using currentD_weight_OUT[OF f, of x]
       by(cases "x \<in> RF (TER f)")(auto simp add: d_IN_restrict_current_outside roofed_circ_def restrict_current_IN_not_RF[OF g] SAT.IN currentD_IN[OF g] roofed_greaterI SAT.A SINK.simps RF_in_B split: if_split_asm intro: essentialI[OF rtrancl_path.base])
   qed(simp add: roofed_greaterI)
   show "x \<in> SAT ?\<Gamma> ?g" if "x \<in> RF (TER f)" for x using that
     by(auto simp add: SAT.simps roofed_circ_def d_IN_restrict_current_outside)
   show "x \<in> SAT ?\<Gamma> ?g" if "x \<in> SAT \<Gamma> g" "x \<notin> A \<Gamma>" for x using that
     by(auto simp add: SAT.simps roofed_circ_def d_IN_restrict_current_outside restrict_current_IN_not_RF[OF g])
 qed
 
 lemma current_restrict_current:
   fixes \<Gamma> (structure)
   assumes w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
   shows "current (quotient_web \<Gamma> f) (g \<upharpoonleft> \<Gamma> / f)" (is "current ?\<Gamma> ?g")
 proof
   show "d_OUT ?g x \<le> weight ?\<Gamma> x" for x
     using d_OUT_restrict_current_le[of \<Gamma> f g x] currentD_weight_OUT[OF g, of x] currentD_OUT[OF g, of x]
     by(auto simp add: d_OUT_restrict_current_outside)
   show "d_IN ?g x \<le> weight ?\<Gamma> x" for x
     using d_IN_restrict_current_le[of \<Gamma> f g x] currentD_weight_IN[OF g, of x]
     by(auto simp add: d_IN_restrict_current_outside roofed_circ_def)
       (subst d_IN_restrict_current_outside[of x \<Gamma> f g]; simp add: roofed_greaterI)
 
   fix x
   assume "x \<notin> A ?\<Gamma>"
   hence x: "x \<notin> \<E> (TER f) - B \<Gamma>" by simp
   show "d_OUT ?g x \<le> d_IN ?g x"
   proof(cases "x \<in> RF (TER f)")
     case True
     with x have "x \<in> RF\<^sup>\<circ> (TER f) \<union> B \<Gamma>" by(simp add: roofed_circ_def)
     with True show ?thesis using currentD_OUT[OF g, of x] d_OUT_restrict_current_le[of \<Gamma> f g x]
       by(auto simp add: d_OUT_restrict_current_outside d_IN_restrict_current_outside)
   next
     case False
     then obtain p z where z: "z \<in> B \<Gamma>" and p: "path \<Gamma> x p z"
       and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER f" "x \<notin> TER f"
       by(clarsimp simp add: roofed_def)
     from g False have "d_IN ?g x = d_IN g x" by(rule restrict_current_IN_not_RF)
     moreover have "d_OUT ?g x \<le> d_OUT g x"
       by(rule d_OUT_mono restrict_current_le)+
     moreover have "x \<notin> A \<Gamma>"
       using separatingD[OF waveD_separating[OF w] p _ z] bypass by blast
     note currentD_OUT_IN[OF g this]
     ultimately show ?thesis by simp
   qed
 next
   show "d_IN ?g a = 0" if "a \<in> A ?\<Gamma>" for a using that by(rule restrict_current_IN_A)
   show "d_OUT ?g b = 0" if "b \<in> B ?\<Gamma>" for b
     using d_OUT_restrict_current_le[of \<Gamma> f g b] currentD_OUT[OF g, of b] that by simp
   show "?g e = 0" if "e \<notin> \<^bold>E\<^bsub>?\<Gamma>\<^esub>" for e using that currentD_outside'[OF g, of e]
     by(cases e)(auto split: split_indicator)
 qed
 
 lemma TER_restrict_current:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
   shows "TER g \<subseteq> TER\<^bsub>quotient_web \<Gamma> f\<^esub> (g \<upharpoonleft> \<Gamma> / f)" (is "_ \<subseteq> ?TER" is "_ \<subseteq> TER\<^bsub>?\<Gamma>\<^esub> ?g")
 proof
   fix x
   assume x: "x \<in> TER g"
   hence "x \<in> SINK ?g" by(simp add: in_SINK_restrict_current)
   moreover have "x \<in> RF (TER f)" if "x \<in> A \<Gamma>"
     using waveD_separating[OF w, THEN separatingD, OF _ that] by(rule roofedI)
   then have "x \<in> SAT ?\<Gamma> ?g" using SAT_restrict_current[OF f g] x by auto
   ultimately show "x \<in> ?TER" by simp
 qed
 
 lemma wave_restrict_current:
   fixes \<Gamma> (structure)
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current \<Gamma> g"
   and w': "wave \<Gamma> g"
   shows "wave (quotient_web \<Gamma> f) (g \<upharpoonleft> \<Gamma> / f)" (is "wave ?\<Gamma> ?g")
 proof
   show "separating ?\<Gamma> (TER\<^bsub>?\<Gamma>\<^esub> ?g)" (is "separating _ ?TER")
   proof
     fix x y p
     assume "x \<in> A ?\<Gamma>" "y \<in> B ?\<Gamma>" and p: "path ?\<Gamma> x p y"
     hence x: "x \<in> \<E> (TER f)" and y: "y \<in> B \<Gamma>" and SAT: "x \<in> SAT ?\<Gamma> ?g" by(simp_all add: SAT.A)
     from p have p': "path \<Gamma> x p y" by(rule rtrancl_path_mono) simp
 
     { assume "x \<notin> ?TER"
       hence "x \<notin> SINK ?g" using SAT by(simp)
       hence "x \<notin> SINK g" using d_OUT_restrict_current_le[of \<Gamma> f g x]
         by(auto simp add: SINK.simps)
       hence "x \<in> RF (TER g)" using waveD_OUT[OF w'] by(auto simp add: SINK.simps)
       from roofedD[OF this p' y] \<open>x \<notin> SINK g\<close> have "(\<exists>z\<in>set p. z \<in> ?TER)"
         using TER_restrict_current[OF f w g] by blast }
     then show "(\<exists>z\<in>set p. z \<in> ?TER) \<or> x \<in> ?TER" by blast
   qed
 
   fix x
   assume "x \<notin> RF\<^bsub>?\<Gamma>\<^esub> ?TER"
   hence "x \<notin> RF (TER g)"
   proof(rule contrapos_nn)
     assume *: "x \<in> RF (TER g)"
     show "x \<in> RF\<^bsub>?\<Gamma>\<^esub> ?TER"
     proof
       fix p y
       assume "path ?\<Gamma> x p y" "y \<in> B ?\<Gamma>"
       hence "path \<Gamma> x p y" "y \<in> B \<Gamma>" by(auto elim: rtrancl_path_mono)
       from roofedD[OF * this] show "(\<exists>z\<in>set p. z \<in> ?TER) \<or> x \<in> ?TER"
         using TER_restrict_current[OF f w g] by blast
     qed
   qed
   with w' have "d_OUT g x = 0" by(rule waveD_OUT)
   with d_OUT_restrict_current_le[of \<Gamma> f g x]
   show "d_OUT ?g x = 0" by simp
 qed
 
 definition plus_current :: "'v current \<Rightarrow> 'v current \<Rightarrow> 'v current"
 where "plus_current f g = (\<lambda>e. f e + g e)"
 
 lemma plus_current_simps [simp]: "plus_current f g e = f e + g e"
 by(simp add: plus_current_def)
 
 lemma plus_zero_current [simp]: "plus_current f zero_current = f"
 by(simp add: fun_eq_iff)
 
 lemma support_flow_plus_current: "support_flow (plus_current f g) \<subseteq> support_flow f \<union> support_flow g"
 by(clarsimp simp add: support_flow.simps)
 
 context
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure) and f g
   assumes f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and g: "current (quotient_web \<Gamma> f) g"
 begin
 
 lemma OUT_plus_current: "d_OUT (plus_current f g) x = (if x \<in> RF\<^sup>\<circ> (TER f) then d_OUT f x else d_OUT g x)" (is "d_OUT ?g _ = _")
 proof -
   have "d_OUT ?g x = d_OUT f x + d_OUT g x" unfolding plus_current_def
     by(subst d_OUT_add) simp_all
   also have "\<dots> = (if x \<in> RF\<^sup>\<circ> (TER f) then d_OUT f x else d_OUT g x)"
   proof(cases "x \<in> RF\<^sup>\<circ> (TER f)")
     case True
     hence "d_OUT g x = 0" by(intro currentD_outside_OUT[OF g])(auto dest: vertex_quotient_webD)
     thus ?thesis using True by simp
   next
     case False
     hence "d_OUT f x = 0" by(auto simp add: roofed_circ_def SINK.simps dest: waveD_OUT[OF w])
     with False show ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 lemma IN_plus_current: "d_IN (plus_current f g) x = (if x \<in> RF (TER f) then d_IN f x else d_IN g x)" (is "d_IN ?g _ = _")
 proof -
   have "d_IN ?g x = d_IN f x + d_IN g x" unfolding plus_current_def
     by(subst d_IN_add) simp_all
   also consider (RF) "x \<in> RF (TER f) - (B \<Gamma> - A \<Gamma>)" | (B) "x \<in> RF (TER f)" "x \<in> B \<Gamma> - A \<Gamma>" | (beyond) "x \<notin> RF (TER f)" by blast
   then have "d_IN f x + d_IN g x = (if x \<in> RF (TER f) then d_IN f x else d_IN g x)"
   proof(cases)
     case RF
     hence "d_IN g x = 0"
       by(cases "x \<in> \<E> (TER f)")(auto intro: currentD_outside_IN[OF g] currentD_IN[OF g] dest!: vertex_quotient_webD simp add: roofed_circ_def)
     thus ?thesis using RF by simp
   next
     case B
     hence "d_IN g x = 0" using currentD_outside_IN[OF g, of x] currentD_weight_IN[OF g, of x]
       by(auto dest: vertex_quotient_webD simp add: roofed_circ_def)
     with B show ?thesis by simp
   next
     case beyond
     from f w beyond have "d_IN f x = 0" by(rule wave_not_RF_IN_zero)
     with beyond show ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 lemma in_TER_plus_current:
   assumes RF: "x \<notin> RF\<^sup>\<circ> (TER f)"
   and x: "x \<in> TER\<^bsub>quotient_web \<Gamma> f\<^esub> g" (is "_ \<in> ?TER _")
   shows "x \<in> TER (plus_current f g)"  (is "_ \<in> TER ?g")
 proof(cases "x \<in> \<E> (TER f) - (B \<Gamma> - A \<Gamma>)")
   case True
   with x show ?thesis using currentD_IN[OF g, of x]
     by(fastforce intro: roofed_greaterI SAT.intros simp add: SINK.simps OUT_plus_current IN_plus_current elim!: SAT.cases)
 next
   case *: False
   have "x \<in> SAT \<Gamma> ?g"
   proof(cases "x \<in> B \<Gamma> - A \<Gamma>")
     case False
     with x RF * have "weight \<Gamma> x \<le> d_IN g x"
       by(auto elim!: SAT.cases split: if_split_asm simp add: essential_BI)
     also have "\<dots> \<le> d_IN ?g x" unfolding plus_current_def by(intro d_IN_mono) simp
     finally show ?thesis ..
   next
     case True
     with * x have "weight \<Gamma> x \<le> d_IN ?g x" using currentD_OUT[OF f, of x]
       by(auto simp add: IN_plus_current RF_in_B SINK.simps roofed_circ_def elim!: SAT.cases split: if_split_asm)
     thus ?thesis ..
   qed
   moreover have "x \<in> SINK ?g" using x by(simp add: SINK.simps OUT_plus_current RF)
   ultimately show ?thesis by simp
 qed
 
 lemma current_plus_current: "current \<Gamma> (plus_current f g)" (is "current _ ?g")
 proof
   show "d_OUT ?g x \<le> weight \<Gamma> x" for x
     using currentD_weight_OUT[OF g, of x] currentD_weight_OUT[OF f, of x]
     by(auto simp add: OUT_plus_current split: if_split_asm elim: order_trans)
   show "d_IN ?g x \<le> weight \<Gamma> x" for x
     using currentD_weight_IN[OF f, of x] currentD_weight_IN[OF g, of x]
     by(auto simp add: IN_plus_current roofed_circ_def split: if_split_asm elim: order_trans)
   show "d_OUT ?g x \<le> d_IN ?g x" if "x \<notin> A \<Gamma>" for x
   proof(cases "x \<in> \<E> (TER f)")
     case False
     thus ?thesis
       using currentD_OUT_IN[OF f that] currentD_OUT_IN[OF g, of x] that
       by(auto simp add: OUT_plus_current IN_plus_current roofed_circ_def SINK.simps)
   next
     case True
     with that have "d_OUT f x = 0" "weight \<Gamma> x \<le> d_IN f x"
       by(auto simp add: SINK.simps elim: SAT.cases)
     thus ?thesis using that True currentD_OUT_IN[OF g, of x] currentD_weight_OUT[OF g, of x]
       by(auto simp add: OUT_plus_current IN_plus_current roofed_circ_def intro: roofed_greaterI split: if_split_asm)
   qed
   show "d_IN ?g a = 0" if "a \<in> A \<Gamma>" for a
     using wave_A_in_RF[OF w that] currentD_IN[OF f that] by(simp add: IN_plus_current)
   show "d_OUT ?g b = 0" if "b \<in> B \<Gamma>" for b
     using that currentD_OUT[OF f that] currentD_OUT[OF g, of b] that
     by(auto simp add: OUT_plus_current SINK.simps roofed_circ_def intro: roofed_greaterI)
   show "?g e = 0" if "e \<notin> \<^bold>E" for e using currentD_outside'[OF f, of e] currentD_outside'[OF g, of e] that
     by(cases e) auto
 qed
 
 context
   assumes w': "wave (quotient_web \<Gamma> f) g"
 begin
 
 lemma separating_TER_plus_current:
   assumes x: "x \<in> RF (TER f)" and y: "y \<in> B \<Gamma>" and p: "path \<Gamma> x p y"
   shows "(\<exists>z\<in>set p. z \<in> TER (plus_current f g)) \<or> x \<in> TER (plus_current f g)" (is "_ \<or> _ \<in> TER ?g")
 proof -
   from x have "x \<in> RF (\<E> (TER f))" unfolding RF_essential .
   from roofedD[OF this p y] have "\<exists>z\<in>set (x # p). z \<in> \<E> (TER f)" by auto
   from split_list_last_prop[OF this] obtain ys z zs
     where decomp: "x # p = ys @ z # zs" and z: "z \<in> \<E> (TER f)"
     and outside: "\<And>z. z \<in> set zs \<Longrightarrow> z \<notin> \<E> (TER f)" by auto
   have zs: "path \<Gamma> z zs y" using decomp p
     by(cases ys)(auto elim: rtrancl_path_appendE)
   moreover have "z \<notin> RF\<^sup>\<circ> (TER f)" using z by(simp add: roofed_circ_def)
   moreover have RF: "z' \<notin> RF (TER f)" if "z' \<in> set zs" for z'
   proof
     assume "z' \<in> RF (TER f)"
     hence z': "z' \<in> RF (\<E> (TER f))" by(simp only: RF_essential)
     from split_list[OF that] obtain ys' zs' where decomp': "zs = ys' @ z' # zs'" by blast
     with zs have "path \<Gamma> z' zs' y" by(auto elim: rtrancl_path_appendE)
     from roofedD[OF z' this y] outside decomp' show False by auto
   qed
   ultimately have p': "path (quotient_web \<Gamma> f) z zs y" by(rule path_quotient_web)
   show ?thesis
   proof(cases "z \<in> B \<Gamma> - A \<Gamma>")
     case False
     with separatingD[OF waveD_separating[OF w'] p'] z y
     obtain z' where z': "z' \<in> set (z # zs)" and TER: "z' \<in> TER\<^bsub>quotient_web \<Gamma> f\<^esub> g" by auto
     hence "z' \<in> TER ?g" using in_TER_plus_current[of z'] RF[of z'] \<open>z \<notin> RF\<^sup>\<circ> (TER f)\<close> by(auto simp add: roofed_circ_def)
     with decomp z' show ?thesis by(cases ys) auto
   next
     case True
     hence "z \<in> TER ?g" using currentD_OUT[OF current_plus_current, of z] z
       by(auto simp add: SINK.simps SAT.simps IN_plus_current intro: roofed_greaterI)
     then show ?thesis using decomp by(cases ys) auto
   qed
 qed
 
 lemma wave_plus_current: "wave \<Gamma> (plus_current f g)" (is "wave _ ?g")
 proof
   let ?\<Gamma> = "quotient_web \<Gamma> f"
   let ?TER = "TER\<^bsub>?\<Gamma>\<^esub>"
 
   show "separating \<Gamma> (TER ?g)" using separating_TER_plus_current[OF wave_A_in_RF[OF w]] by(rule separating)
 
   fix x
   assume x: "x \<notin> RF (TER ?g)"
   hence "x \<notin> RF (TER f)" by(rule contrapos_nn)(rule roofedI, rule separating_TER_plus_current)
   hence *: "x \<notin> RF\<^sup>\<circ> (TER f)" by(simp add: roofed_circ_def)
   moreover have "x \<notin> RF\<^bsub>?\<Gamma>\<^esub> (?TER g)"
   proof
     assume RF': "x \<in> RF\<^bsub>?\<Gamma>\<^esub> (?TER g)"
     from x obtain p y where y: "y \<in> B \<Gamma>" and p: "path \<Gamma> x p y"
       and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> TER ?g" and x': "x \<notin> TER ?g"
       by(auto simp add: roofed_def)
     have RF: "z \<notin> RF (TER f)" if "z \<in> set p" for z
     proof
       assume z: "z \<in> RF (TER f)"
       from split_list[OF that] obtain ys' zs' where decomp: "p = ys' @ z # zs'" by blast
       with p have "path \<Gamma> z zs' y" by(auto elim: rtrancl_path_appendE)
       from separating_TER_plus_current[OF z y this] decomp bypass show False by auto
     qed
     with p have "path ?\<Gamma> x p y" using *
       by(induction)(auto intro: rtrancl_path.intros simp add: roofed_circ_def)
     from roofedD[OF RF' this] y consider (x) "x \<in> ?TER g" | (z) z where "z \<in> set p" "z \<in> ?TER g" by auto
     then show False
     proof(cases)
       case x
       with * have "x \<in> TER ?g" by(rule in_TER_plus_current)
       with x' show False by contradiction
     next
       case (z z)
       from z(1) have "z \<notin> RF (TER f)" by(rule RF)
       hence "z \<notin> RF\<^sup>\<circ> (TER f)" by(simp add: roofed_circ_def)
       hence "z \<in> TER ?g" using z(2) by(rule in_TER_plus_current)
       moreover from z(1) have "z \<notin> TER ?g" by(rule bypass)
       ultimately show False by contradiction
     qed
   qed
   with w' have "d_OUT g x = 0" by(rule waveD_OUT)
   ultimately show "d_OUT ?g x = 0" by(simp add: OUT_plus_current)
 qed
 
 end
 
 end
 
 lemma loose_quotient_web:
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure)
   assumes weight_finite: "\<And>x. weight \<Gamma> x \<noteq> \<top>"
   and f: "current \<Gamma> f"
   and w: "wave \<Gamma> f"
   and maximal: "\<And>w. \<lbrakk> current \<Gamma> w; wave \<Gamma> w; f \<le> w \<rbrakk> \<Longrightarrow> f = w"
   shows "loose (quotient_web \<Gamma> f)" (is "loose ?\<Gamma>")
 proof
   fix g
   assume g: "current ?\<Gamma> g" and w': "wave ?\<Gamma> g"
   let ?g = "plus_current f g"
   from f w g have "current \<Gamma> ?g" "wave \<Gamma> ?g" by(rule current_plus_current wave_plus_current)+ (rule w')
   moreover have "f \<le> ?g" by(clarsimp simp add: le_fun_def add_eq_0_iff_both_eq_0)
   ultimately have eq: "f = ?g" by(rule maximal)
   have "g e = 0" for e
   proof(cases e)
     case (Pair x y)
     have "f e \<le> d_OUT f x" unfolding Pair by (rule d_OUT_ge_point)
     also have "\<dots> \<le> weight \<Gamma> x" by(rule currentD_weight_OUT[OF f])
     also have "\<dots> < \<top>" by(simp add: weight_finite less_top[symmetric])
     finally show "g e = 0" using Pair eq[THEN fun_cong, of e]
       by(cases "f e" "g e" rule: ennreal2_cases)(simp_all add: fun_eq_iff)
   qed
   thus "g = (\<lambda>_. 0)" by(simp add: fun_eq_iff)
 next
-  have 0: "current ?\<Gamma> zero_current" bysimp
+  have 0: "current ?\<Gamma> zero_current" by simp
   show "\<not> hindrance ?\<Gamma> zero_current"
   proof
     assume "hindrance ?\<Gamma> zero_current"
     then obtain x where a: "x \<in> A ?\<Gamma>" and \<E>: "x \<notin> \<E>\<^bsub>?\<Gamma>\<^esub> (TER\<^bsub>?\<Gamma>\<^esub> zero_current)"
       and "d_OUT zero_current x < weight ?\<Gamma> x" by cases
     from a have "x \<in> \<E> (TER f)" by simp
     then obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>"
       and bypass: "\<And>z. \<lbrakk>x \<noteq> y; z \<in> set p\<rbrakk> \<Longrightarrow> z = x \<or> z \<notin> TER f" by(rule \<E>_E) blast
     from p obtain p' where p': "path \<Gamma> x p' y" and distinct: "distinct (x # p')"
       and subset: "set p' \<subseteq> set p" by(auto elim: rtrancl_path_distinct)
     note p'
     moreover have RF: "z \<notin> RF (TER f)" if "z \<in> set p'" for z
     proof
       assume z: "z \<in> RF (TER f)"
       from split_list[OF that] obtain ys zs where decomp: "p' = ys @ z # zs" by blast
       with p' have "y \<in> set p'" by(auto dest!: rtrancl_path_last intro: last_in_set)
       with distinct have neq: "x \<noteq> y" by auto
       from decomp p' have "path \<Gamma> z zs y" by(auto elim: rtrancl_path_appendE)
       from roofedD[OF z this y] obtain z' where "z' \<in> set (z # zs)" "z' \<in> TER f" by auto
       with distinct decomp subset bypass[OF neq] show False by auto
     qed
     moreover have "x \<notin> RF\<^sup>\<circ> (TER f)" using \<open>x \<in> \<E> (TER f)\<close> by(simp add: roofed_circ_def)
     ultimately have p'': "path ?\<Gamma> x p' y"
       by(induction)(auto intro: rtrancl_path.intros simp add: roofed_circ_def)
     from a \<E> have "\<not> essential ?\<Gamma> (B ?\<Gamma>) (TER\<^bsub>?\<Gamma>\<^esub> zero_current) x" by simp
     from not_essentialD[OF this p''] y obtain z where neq: "x \<noteq> y"
       and "z \<in> set p'" "z \<noteq> x" "z \<in> TER\<^bsub>?\<Gamma>\<^esub> zero_current" by auto
     moreover with subset RF[of z] have "z \<in> TER f"
       using currentD_weight_OUT[OF f, of z] currentD_weight_IN[OF f, of z]
       by(auto simp add: roofed_circ_def SINK.simps intro: SAT.IN split: if_split_asm)
     ultimately show False using bypass[of z] subset by auto
   qed
 qed
 
 lemma quotient_web_trimming:
   fixes \<Gamma> (structure)
   assumes w: "wave \<Gamma> f"
   and trimming: "trimming \<Gamma> f g"
   shows "quotient_web \<Gamma> f = quotient_web \<Gamma> g" (is "?lhs = ?rhs")
 proof(rule web.equality)
   from trimming have \<E>: "\<E> (TER g) - A \<Gamma> = \<E> (TER f) - A \<Gamma>" by cases
 
   have RF: "RF (TER g) = RF (TER f)"
     by(subst (1 2) RF_essential[symmetric])(simp only: trimming_\<E>[OF w trimming])
   have RFc: "RF\<^sup>\<circ> (TER g) = RF\<^sup>\<circ> (TER f)"
     by(subst (1 2) roofed_circ_essential[symmetric])(simp only: trimming_\<E>[OF w trimming])
 
   show "edge ?lhs = edge ?rhs" by(rule ext)+(simp add: RF RFc)
   have "weight ?lhs = (\<lambda>x. if x \<in> RF\<^sup>\<circ> (TER g) \<or> x \<in> RF (TER g) \<inter> B \<Gamma> then 0 else weight \<Gamma> x)"
     unfolding RF RFc by(auto simp add: fun_eq_iff RF_in_B)
   also have "\<dots> = weight ?rhs" by(auto simp add: fun_eq_iff RF_in_B)
   finally show "weight ?lhs = weight ?rhs" .
 
   show "A ?lhs = A ?rhs" unfolding quotient_web_sel trimming_\<E>[OF w trimming] ..
 qed simp_all
 
 subsection \<open>Well-formed webs\<close>
 
 locale web =
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure)
   assumes A_in: "x \<in> A \<Gamma> \<Longrightarrow> \<not> edge \<Gamma> y x"
   and B_out: "x \<in> B \<Gamma> \<Longrightarrow> \<not> edge \<Gamma> x y"
   and A_vertex: "A \<Gamma> \<subseteq> \<^bold>V"
   and disjoint: "A \<Gamma> \<inter> B \<Gamma> = {}"
   and no_loop: "\<And>x. \<not> edge \<Gamma> x x"
   and weight_outside: "\<And>x. x \<notin> \<^bold>V \<Longrightarrow> weight \<Gamma> x = 0"
   and weight_finite [simp]: "\<And>x. weight \<Gamma> x \<noteq> \<top>"
 begin
 
 lemma web_weight_update:
   assumes "\<And>x. \<not> vertex \<Gamma> x \<Longrightarrow> w x = 0"
   and "\<And>x. w x \<noteq> \<top>"
   shows "web (\<Gamma>\<lparr>weight := w\<rparr>)"
 by unfold_locales(simp_all add: A_in B_out A_vertex disjoint no_loop assms)
 
 lemma currentI [intro?]:
   assumes "\<And>x. d_OUT f x \<le> weight \<Gamma> x"
   and "\<And>x. d_IN f x \<le> weight \<Gamma> x"
   and OUT_IN: "\<And>x. \<lbrakk> x \<notin> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> d_OUT f x \<le> d_IN f x"
   and outside: "\<And>e. e \<notin> \<^bold>E \<Longrightarrow> f e = 0"
   shows "current \<Gamma> f"
 proof
   show "d_IN f a = 0" if "a \<in> A \<Gamma>" for a using that
     by(auto simp add: d_IN_def nn_integral_0_iff emeasure_count_space_eq_0 A_in intro: outside)
   show "d_OUT f b = 0" if "b \<in> B \<Gamma>" for b using that
     by(auto simp add: d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0 B_out intro: outside)
   then show "d_OUT f x \<le> d_IN f x" if "x \<notin> A \<Gamma>" for x using OUT_IN[OF that]
     by(cases "x \<in> B \<Gamma>") auto
 qed(blast intro: assms)+
 
 lemma currentD_finite_IN:
   assumes f: "current \<Gamma> f"
   shows "d_IN f x \<noteq> \<top>"
 proof(cases "x \<in> \<^bold>V")
   case True
   have "d_IN f x \<le> weight \<Gamma> x" using f by(rule currentD_weight_IN)
   also have "\<dots> < \<top>" using True weight_finite[of x] by (simp add: less_top[symmetric])
   finally show ?thesis by simp
 next
   case False
   then have "d_IN f x = 0"
     by(auto simp add: d_IN_def nn_integral_0_iff emeasure_count_space_eq_0 vertex_def intro: currentD_outside[OF f])
   thus ?thesis by simp
 qed
 
 lemma currentD_finite_OUT:
   assumes f: "current \<Gamma> f"
   shows "d_OUT f x \<noteq> \<top>"
 proof(cases "x \<in> \<^bold>V")
   case True
   have "d_OUT f x \<le> weight \<Gamma> x" using f by(rule currentD_weight_OUT)
   also have "\<dots> < \<top>" using True weight_finite[of x] by (simp add: less_top[symmetric])
   finally show ?thesis by simp
 next
   case False
   then have "d_OUT f x = 0"
     by(auto simp add: d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0 vertex_def intro: currentD_outside[OF f])
   thus ?thesis by simp
 qed
 
 lemma currentD_finite:
   assumes f: "current \<Gamma> f"
   shows "f e \<noteq> \<top>"
 proof(cases e)
   case (Pair x y)
   have "f (x, y) \<le> d_OUT f x" by (rule d_OUT_ge_point)
   also have "\<dots> < \<top>" using currentD_finite_OUT[OF f] by (simp add: less_top[symmetric])
   finally show ?thesis by(simp add: Pair)
 qed
 
 lemma web_quotient_web: "web (quotient_web \<Gamma> f)" (is "web ?\<Gamma>")
 proof
   show "\<not> edge ?\<Gamma> y x" if "x \<in> A ?\<Gamma>" for x y using that by(auto intro: roofed_greaterI)
   show "\<not> edge ?\<Gamma> x y" if "x \<in> B ?\<Gamma>" for x y using that by(auto simp add: B_out)
   show "A ?\<Gamma> \<inter> B ?\<Gamma> = {}" using disjoint by auto
   show "A ?\<Gamma> \<subseteq> \<^bold>V\<^bsub>?\<Gamma>\<^esub>"
   proof
     fix x
     assume "x \<in> A ?\<Gamma>"
     hence \<E>: "x \<in> \<E> (TER f)" and x: "x \<notin> B \<Gamma>" using disjoint by auto
     from this(1) obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)"
       by(rule \<E>_E_RF) blast
     from p y x have "p \<noteq> []" by(auto simp add: rtrancl_path_simps)
     with rtrancl_path_nth[OF p, of 0] have "edge \<Gamma> x (p ! 0)" by simp
     moreover have "x \<notin> RF\<^sup>\<circ> (TER f)" using \<E> by(simp add: roofed_circ_def)
     moreover have "p ! 0 \<notin> RF (TER f)" using bypass \<open>p \<noteq> []\<close> by auto
     ultimately have "edge ?\<Gamma> x (p ! 0)" by simp
     thus "x \<in> \<^bold>V\<^bsub>?\<Gamma>\<^esub>" by(auto intro: vertexI1)
   qed
   show "\<not> edge ?\<Gamma> x x" for x by(simp add: no_loop)
   show "weight ?\<Gamma> x = 0" if "x \<notin> \<^bold>V\<^bsub>?\<Gamma>\<^esub>" for x
   proof(cases "x \<in> RF\<^sup>\<circ> (TER f) \<or> x \<in> TER f \<inter> B \<Gamma>")
     case True thus ?thesis by simp
   next
     case False
     hence RF: "x \<notin> RF\<^sup>\<circ> (TER f)" and B: "x \<in> B \<Gamma> \<Longrightarrow> x \<notin> TER f" by auto
     from RF obtain p y where p: "path \<Gamma> x p y" and y: "y \<in> B \<Gamma>" and bypass: "\<And>z. z \<in> set p \<Longrightarrow> z \<notin> RF (TER f)"
       apply(cases "x \<notin> RF (RF (TER f))")
        apply(auto elim!: not_roofedE)[1]
       apply(auto simp add: roofed_circ_def roofed_idem elim: essentialE_RF)
       done
     from that have "p = []" using p y B RF bypass
       by(auto 4 3 simp add: vertex_def dest!: rtrancl_path_nth[where i=0])
     with p have xy: "x = y" by(simp add: rtrancl_path_simps)
     with B y have "x \<notin> TER f" by simp
     hence RF': "x \<notin> RF (TER f)" using xy y by(subst RF_in_B) auto
     have "\<not> vertex \<Gamma> x"
     proof
       assume "vertex \<Gamma> x"
       then obtain x' where "edge \<Gamma> x' x" using xy y by(auto simp add: vertex_def B_out)
       moreover hence "x' \<notin> RF\<^sup>\<circ> (TER f)" using RF' by(auto dest: RF_circ_edge_forward)
       ultimately have "edge ?\<Gamma> x' x" using RF' by simp
       hence "vertex ?\<Gamma> x" by(rule vertexI2)
       with that show False by simp
     qed
     thus ?thesis by(simp add: weight_outside)
   qed
   show "weight ?\<Gamma> x \<noteq> \<top>" for x by simp
 qed
 
 end
 
 locale countable_web = web \<Gamma>
   for \<Gamma> :: "('v, 'more) web_scheme" (structure)
   +
   assumes countable [simp]: "countable \<^bold>E"
 begin
 
 lemma countable_V [simp]: "countable \<^bold>V"
 by(simp add: "\<^bold>V_def")
 
 lemma countable_web_quotient_web: "countable_web (quotient_web \<Gamma> f)" (is "countable_web ?\<Gamma>")
 proof -
   interpret r: web ?\<Gamma> by(rule web_quotient_web)
   show ?thesis
   proof
     have "\<^bold>E\<^bsub>?\<Gamma>\<^esub> \<subseteq> \<^bold>E" by auto
     then show "countable \<^bold>E\<^bsub>?\<Gamma>\<^esub>" by(rule countable_subset) simp
   qed
 qed
 
 end
 
 subsection \<open>Subtraction of a wave\<close>
 
 definition minus_web :: "('v, 'more) web_scheme \<Rightarrow> 'v current \<Rightarrow> ('v, 'more) web_scheme" (infixl "\<ominus>" 65) \<comment> \<open>Definition 6.6\<close>
 where "\<Gamma> \<ominus> f = \<Gamma>\<lparr>weight := \<lambda>x. if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT f x else weight \<Gamma> x + d_OUT f x - d_IN f x\<rparr>"
 
 lemma minus_web_sel [simp]:
   "edge (\<Gamma> \<ominus> f) = edge \<Gamma>"
   "weight (\<Gamma> \<ominus> f) x = (if x \<in> A \<Gamma> then weight \<Gamma> x - d_OUT f x else weight \<Gamma> x + d_OUT f x - d_IN f x)"
   "A (\<Gamma> \<ominus> f) = A \<Gamma>"
   "B (\<Gamma> \<ominus> f) = B \<Gamma>"
   "\<^bold>V\<^bsub>\<Gamma> \<ominus> f\<^esub> = \<^bold>V\<^bsub>\<Gamma>\<^esub>"
   "\<^bold>E\<^bsub>\<Gamma> \<ominus> f\<^esub> = \<^bold>E\<^bsub>\<Gamma>\<^esub>"
   "web.more (\<Gamma> \<ominus> f) = web.more \<Gamma>"
 by(auto simp add: minus_web_def vertex_def)
 
 lemma vertex_minus_web [simp]: "vertex (\<Gamma> \<ominus> f) = vertex \<Gamma>"
 by(simp add: vertex_def fun_eq_iff)
 
 lemma roofed_gen_minus_web [simp]: "roofed_gen (\<Gamma> \<ominus> f) = roofed_gen \<Gamma>"
 by(simp add: fun_eq_iff roofed_def)
 
 lemma minus_zero_current [simp]: "\<Gamma> \<ominus> zero_current = \<Gamma>"
 by(rule web.equality)(simp_all add: fun_eq_iff)
 
 lemma (in web) web_minus_web:
   assumes f: "current \<Gamma> f"
   shows "web (\<Gamma> \<ominus> f)"
 unfolding minus_web_def
 apply(rule web_weight_update)
 apply(auto simp: weight_outside currentD_weight_IN[OF f] currentD_outside_OUT[OF f]
                  currentD_outside_IN[OF f] currentD_weight_OUT[OF f] currentD_finite_OUT[OF f])
 done
 
 subsection \<open>Bipartite webs\<close>
 
 locale countable_bipartite_web =
   fixes \<Gamma> :: "('v, 'more) web_scheme" (structure)
   assumes bipartite_V: "\<^bold>V \<subseteq> A \<Gamma> \<union> B \<Gamma>"
   and A_vertex: "A \<Gamma> \<subseteq> \<^bold>V"
   and bipartite_E: "edge \<Gamma> x y \<Longrightarrow> x \<in> A \<Gamma> \<and> y \<in> B \<Gamma>"
   and disjoint: "A \<Gamma> \<inter> B \<Gamma> = {}"
   and weight_outside: "\<And>x. x \<notin> \<^bold>V \<Longrightarrow> weight \<Gamma> x = 0"
   and weight_finite [simp]: "\<And>x. weight \<Gamma> x \<noteq> \<top>"
   and countable_E [simp]: "countable \<^bold>E"
 begin
 
 lemma not_vertex: "\<lbrakk> x \<notin> A \<Gamma>; x \<notin> B \<Gamma> \<rbrakk> \<Longrightarrow> \<not> vertex \<Gamma> x"
 using bipartite_V by blast
 
 lemma no_loop: "\<not> edge \<Gamma> x x"
 using disjoint by(auto dest: bipartite_E)
 
 lemma edge_antiparallel: "edge \<Gamma> x y \<Longrightarrow> \<not> edge \<Gamma> y x"
 using disjoint by(auto dest: bipartite_E)
 
 lemma A_in: "x \<in> A \<Gamma> \<Longrightarrow> \<not> edge \<Gamma> y x"
 using disjoint by(auto dest: bipartite_E)
 
 lemma B_out: "x \<in> B \<Gamma> \<Longrightarrow> \<not> edge \<Gamma> x y"
 using disjoint by(auto dest: bipartite_E)
 
 sublocale countable_web using disjoint
 by(unfold_locales)(auto simp add: A_in B_out A_vertex no_loop weight_outside)
 
 lemma currentD_OUT':
   assumes f: "current \<Gamma> f"
   and x: "x \<notin> A \<Gamma>"
   shows "d_OUT f x = 0"
 using currentD_outside_OUT[OF f, of x] x currentD_OUT[OF f, of x] bipartite_V by auto
 
 lemma currentD_IN':
   assumes f: "current \<Gamma> f"
   and x: "x \<notin> B \<Gamma>"
   shows "d_IN f x = 0"
 using currentD_outside_IN[OF f, of x] x currentD_IN[OF f, of x] bipartite_V by auto
 
 lemma current_bipartiteI [intro?]:
   assumes OUT: "\<And>x. d_OUT f x \<le> weight \<Gamma> x"
   and IN: "\<And>x. d_IN f x \<le> weight \<Gamma> x"
   and outside: "\<And>e. e \<notin> \<^bold>E \<Longrightarrow> f e = 0"
   shows "current \<Gamma> f"
 proof
   fix x
   assume "x \<notin> A \<Gamma>" "x \<notin> B \<Gamma>"
   hence "d_OUT f x = 0" by(auto simp add: d_OUT_def nn_integral_0_iff emeasure_count_space_eq_0 intro!: outside dest: bipartite_E)
   then show "d_OUT f x \<le> d_IN f x" by simp
 qed(rule OUT IN outside)+
 
 lemma wave_bipartiteI [intro?]:
   assumes sep: "separating \<Gamma> (TER f)"
   and f: "current \<Gamma> f"
   shows "wave \<Gamma> f"
 using sep
 proof(rule wave.intros)
   fix x
   assume "x \<notin> RF (TER f)"
   then consider "x \<notin> \<^bold>V" | "x \<in> \<^bold>V" "x \<in> B \<Gamma>" using separating_RF_A[OF sep] bipartite_V by auto
   then show "d_OUT f x = 0" using currentD_OUT[OF f, of x] currentD_outside_OUT[OF f, of x]
     by cases auto
 qed
 
 
 lemma web_flow_iff: "web_flow \<Gamma> f \<longleftrightarrow> current \<Gamma> f"
 using bipartite_V by(auto simp add: web_flow.simps)
 
 end
 
 end
diff --git a/thys/SC_DOM_Components/Core_DOM_SC_DOM_Components.thy b/thys/SC_DOM_Components/Core_DOM_SC_DOM_Components.thy
--- a/thys/SC_DOM_Components/Core_DOM_SC_DOM_Components.thy
+++ b/thys/SC_DOM_Components/Core_DOM_SC_DOM_Components.thy
@@ -1,3758 +1,3758 @@
 (***********************************************************************************
  * 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>Core SC DOM Components II\<close>
 theory Core_DOM_SC_DOM_Components
   imports
     Core_DOM_DOM_Components
 begin
 declare [[smt_timeout=2400]]
 
 section \<open>Scope Components\<close>
 
 subsection \<open>Definition\<close>
 
 locale l_get_scdom_component\<^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 +
   l_get_owner_document_defs get_owner_document +
   l_to_tree_order_defs to_tree_order
   for get_owner_document :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     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 to_tree_order :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog"
 begin
 definition a_get_scdom_component :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   where
     "a_get_scdom_component ptr = do {
       document \<leftarrow> get_owner_document ptr;
       disc_nodes \<leftarrow> get_disconnected_nodes document;
       tree_order \<leftarrow> to_tree_order (cast document);
       disconnected_tree_orders \<leftarrow> map_M (to_tree_order \<circ> cast) disc_nodes;
       return (tree_order @ (concat disconnected_tree_orders))
     }"
 
 definition a_is_strongly_scdom_component_safe ::
   "(_) object_ptr set \<Rightarrow> (_) object_ptr set \<Rightarrow> (_) heap \<Rightarrow> (_) heap \<Rightarrow> bool"
   where
     "a_is_strongly_scdom_component_safe S\<^sub>a\<^sub>r\<^sub>g S\<^sub>r\<^sub>e\<^sub>s\<^sub>u\<^sub>l\<^sub>t h h' = (
       let removed_pointers = fset (object_ptr_kinds h) - fset (object_ptr_kinds h') in
       let added_pointers = fset (object_ptr_kinds h') - fset (object_ptr_kinds h) in
       let arg_components =
         (\<Union>ptr \<in> (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) \<inter>
         fset (object_ptr_kinds h).  set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) in
       let arg_components' =
         (\<Union>ptr \<in> (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) \<inter>
         fset (object_ptr_kinds h').  set |h' \<turnstile> a_get_scdom_component ptr|\<^sub>r) in
       removed_pointers \<subseteq> arg_components \<and>
       added_pointers \<subseteq> arg_components' \<and>
       S\<^sub>r\<^sub>e\<^sub>s\<^sub>u\<^sub>l\<^sub>t \<subseteq> arg_components' \<and>
       (\<forall>outside_ptr \<in> fset (object_ptr_kinds h) \<inter> fset (object_ptr_kinds h') -
         (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h  \<turnstile> a_get_scdom_component ptr|\<^sub>r). preserved (get_M outside_ptr id) h h'))"
 
 definition a_is_weakly_scdom_component_safe ::
   "(_) object_ptr set \<Rightarrow> (_) object_ptr set \<Rightarrow> (_) heap \<Rightarrow> (_) heap \<Rightarrow> bool"
   where
     "a_is_weakly_scdom_component_safe S\<^sub>a\<^sub>r\<^sub>g S\<^sub>r\<^sub>e\<^sub>s\<^sub>u\<^sub>l\<^sub>t h h' = (
       let removed_pointers = fset (object_ptr_kinds h) - fset (object_ptr_kinds h') in
       let added_pointers = fset (object_ptr_kinds h') - fset (object_ptr_kinds h) in
       let arg_components =
         (\<Union>ptr \<in> (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) \<inter>
         fset (object_ptr_kinds h).  set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) in
       let arg_components' =
         (\<Union>ptr \<in> (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h \<turnstile> a_get_scdom_component ptr|\<^sub>r) \<inter>
         fset (object_ptr_kinds h').  set |h' \<turnstile> a_get_scdom_component ptr|\<^sub>r) in
       removed_pointers \<subseteq> arg_components \<and>
       S\<^sub>r\<^sub>e\<^sub>s\<^sub>u\<^sub>l\<^sub>t \<subseteq> arg_components' \<union> added_pointers  \<and>
       (\<forall>outside_ptr \<in> fset (object_ptr_kinds h) \<inter> fset (object_ptr_kinds h') -
         (\<Union>ptr \<in> S\<^sub>a\<^sub>r\<^sub>g. set |h  \<turnstile> a_get_scdom_component ptr|\<^sub>r). preserved (get_M outside_ptr id) h h'))"
 end
 
 global_interpretation l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_owner_document get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order
   defines get_scdom_component = "l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_scdom_component
 get_owner_document get_disconnected_nodes to_tree_order"
     and is_strongly_scdom_component_safe = a_is_strongly_scdom_component_safe
     and is_weakly_scdom_component_safe = a_is_weakly_scdom_component_safe
   .
 
 locale l_get_scdom_component_defs =
   fixes get_scdom_component :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   fixes is_strongly_scdom_component_safe ::
     "(_) object_ptr set \<Rightarrow> (_) object_ptr set \<Rightarrow> (_) heap \<Rightarrow> (_) heap \<Rightarrow> bool"
   fixes is_weakly_scdom_component_safe ::
     "(_) object_ptr set \<Rightarrow> (_) object_ptr set \<Rightarrow> (_) heap \<Rightarrow> (_) heap \<Rightarrow> bool"
 
 
 locale l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_scdom_component_defs +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   assumes get_scdom_component_impl: "get_scdom_component = a_get_scdom_component"
   assumes is_strongly_scdom_component_safe_impl:
     "is_strongly_scdom_component_safe = a_is_strongly_scdom_component_safe"
   assumes is_weakly_scdom_component_safe_impl:
     "is_weakly_scdom_component_safe = a_is_weakly_scdom_component_safe"
 begin
 lemmas get_scdom_component_def = a_get_scdom_component_def[folded get_scdom_component_impl]
 lemmas is_strongly_scdom_component_safe_def =
   a_is_strongly_scdom_component_safe_def[folded is_strongly_scdom_component_safe_impl]
 lemmas is_weakly_scdom_component_safe_def =
   a_is_weakly_scdom_component_safe_def[folded is_weakly_scdom_component_safe_impl]
 end
 
 interpretation i_get_scdom_component?: l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe
   get_owner_document get_disconnected_nodes get_disconnected_nodes_locs to_tree_order
   by(auto simp add: l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def get_scdom_component_def
       is_strongly_scdom_component_safe_def is_weakly_scdom_component_safe_def instances)
 declare l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 locale l_get_dom_component_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed +
   l_get_owner_document +
   l_get_owner_document_wf +
   l_get_disconnected_nodes +
   l_to_tree_order +
   l_known_ptr +
   l_known_ptrs +
   l_get_owner_document_wf_get_root_node_wf +
   assumes known_ptr_impl: "known_ptr = DocumentClass.known_ptr"
 begin
 
 lemma known_ptr_node_or_document: "known_ptr ptr \<Longrightarrow> is_node_ptr_kind ptr \<or> is_document_ptr_kind ptr"
   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)
 
 lemma get_scdom_component_ptr_in_heap2:
   assumes "h \<turnstile> ok (get_scdom_component ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms get_root_node_ptr_in_heap
   apply(auto simp add: get_scdom_component_def elim!: bind_is_OK_E3 intro!: map_M_pure_I)[1]
   by (simp add: is_OK_returns_result_I local.get_owner_document_ptr_in_heap)
 
 lemma get_scdom_component_subset_get_dom_component:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_dom_component ptr \<rightarrow>\<^sub>r c"
   shows "set c \<subseteq> set sc"
 proof -
   obtain document disc_nodes tree_order disconnected_tree_orders where
     document: "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r document"
     and disc_nodes: "h \<turnstile> get_disconnected_nodes document \<rightarrow>\<^sub>r disc_nodes"
     and tree_order: "h \<turnstile> to_tree_order (cast document) \<rightarrow>\<^sub>r tree_order"
     and disconnected_tree_orders: "h \<turnstile> map_M (to_tree_order \<circ> cast) disc_nodes \<rightarrow>\<^sub>r disconnected_tree_orders"
     and sc: "sc = tree_order @ (concat disconnected_tree_orders)"
     using assms(4)
     by(auto simp add: get_scdom_component_def elim!: bind_returns_result_E
         elim!: bind_returns_result_E2[rotated, OF get_owner_document_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF to_tree_order_pure, rotated]
         )
 
   obtain root_ptr where root_ptr: "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>r root_ptr"
     and c: "h \<turnstile> to_tree_order root_ptr \<rightarrow>\<^sub>r c"
     using assms(5)
     by(auto simp add: get_dom_component_def elim!: bind_returns_result_E2[rotated, OF get_root_node_pure, rotated])
 
   show ?thesis
   proof (cases "is_document_ptr_kind root_ptr")
     case True
     then have "cast document = root_ptr"
       using get_root_node_document assms(1) assms(2) assms(3) root_ptr document
       by (metis document_ptr_casts_commute3 returns_result_eq)
     then have "c = tree_order"
       using tree_order c
       by auto
     then show ?thesis
       by(simp add: sc)
   next
     case False
     moreover have "root_ptr |\<in>| object_ptr_kinds h"
       using assms(1) assms(2) assms(3) local.get_root_node_root_in_heap root_ptr by blast
     ultimately have "is_node_ptr_kind root_ptr"
       using assms(3) known_ptrs_known_ptr known_ptr_node_or_document
       by auto
     then obtain root_node_ptr where root_node_ptr: "root_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 root_node_ptr"
       by (metis node_ptr_casts_commute3)
     then have "h \<turnstile> get_owner_document root_ptr \<rightarrow>\<^sub>r document"
       using get_root_node_same_owner_document
       using assms(1) assms(2) assms(3) document root_ptr by blast
     then have "root_node_ptr \<in> set disc_nodes"
       using assms(1) assms(2) assms(3) disc_nodes in_disconnected_nodes_no_parent root_node_ptr
       using local.get_root_node_same_no_parent root_ptr by blast
     then have "c \<in> set disconnected_tree_orders"
       using c root_node_ptr
       using map_M_pure_E[OF disconnected_tree_orders]
       by (metis (mono_tags, lifting) comp_apply local.to_tree_order_pure select_result_I2)
     then show ?thesis
       by(auto simp add: sc)
   qed
 qed
 
 lemma get_scdom_component_ptrs_same_owner_document:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "ptr' \<in> set sc"
   assumes "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
   shows "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document"
 proof -
   obtain document disc_nodes tree_order disconnected_tree_orders where
     document: "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r document"
     and disc_nodes: "h \<turnstile> get_disconnected_nodes document \<rightarrow>\<^sub>r disc_nodes"
     and tree_order: "h \<turnstile> to_tree_order (cast document) \<rightarrow>\<^sub>r tree_order"
     and disconnected_tree_orders: "h \<turnstile> map_M (to_tree_order \<circ> cast) disc_nodes \<rightarrow>\<^sub>r disconnected_tree_orders"
     and sc: "sc = tree_order @ (concat disconnected_tree_orders)"
     using assms(4)
     by(auto simp add: get_scdom_component_def elim!: bind_returns_result_E
         elim!: bind_returns_result_E2[rotated, OF get_owner_document_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF to_tree_order_pure, rotated]
         )
   show ?thesis
   proof (cases "ptr' \<in> set tree_order")
     case True
     have "owner_document = document"
       using assms(6) document by fastforce
     then show ?thesis
       by (metis (no_types) True assms(1) assms(2) assms(3) 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_inject document
           document_ptr_casts_commute3 document_ptr_document_ptr_cast document_ptr_kinds_commutes
           local.get_owner_document_owner_document_in_heap local.get_root_node_document
           local.get_root_node_not_node_same local.to_tree_order_same_root node_ptr_no_document_ptr_cast tree_order)
   next
     case False
     then obtain disconnected_tree_order where disconnected_tree_order:
       "ptr' \<in> set disconnected_tree_order" and "disconnected_tree_order \<in> set disconnected_tree_orders"
       using sc \<open>ptr' \<in> set sc\<close>
       by auto
     obtain root_ptr' where
       root_ptr': "root_ptr' \<in> set disc_nodes" and
       "h \<turnstile> to_tree_order (cast root_ptr') \<rightarrow>\<^sub>r disconnected_tree_order"
       using map_M_pure_E2[OF disconnected_tree_orders \<open>disconnected_tree_order \<in> set disconnected_tree_orders\<close>]
       by (metis comp_apply local.to_tree_order_pure)
     have "\<not>(\<exists>parent \<in> fset (object_ptr_kinds h). root_ptr' \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r)"
       using disc_nodes
       by (meson assms(1) assms(2) assms(3) disjoint_iff_not_equal local.get_child_nodes_ok
           local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr notin_fset
           returns_result_select_result root_ptr')
     then
     have "h \<turnstile> get_parent root_ptr' \<rightarrow>\<^sub>r None"
       using disc_nodes
       by (metis (no_types, lifting) assms(1) assms(2) assms(3) fmember.rep_eq local.get_parent_child_dual
           local.get_parent_ok local.get_parent_parent_in_heap local.heap_is_wellformed_disc_nodes_in_heap
           returns_result_select_result root_ptr' select_result_I2 split_option_ex)
     then have "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r cast root_ptr'"
       using \<open>h \<turnstile> to_tree_order (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_ptr') \<rightarrow>\<^sub>r disconnected_tree_order\<close> assms(1)
         assms(2) assms(3) disconnected_tree_order local.get_root_node_no_parent
         local.to_tree_order_get_root_node local.to_tree_order_ptr_in_result
       by blast
     then have "h \<turnstile> get_owner_document (cast root_ptr') \<rightarrow>\<^sub>r document"
       using assms(1) assms(2) assms(3) disc_nodes local.get_owner_document_disconnected_nodes root_ptr'
       by blast
 
     then have "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r document"
       using \<open>h \<turnstile> get_root_node ptr' \<rightarrow>\<^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 root_ptr'\<close> assms(1) assms(2) assms(3)
         local.get_root_node_same_owner_document
       by blast
     then show ?thesis
       using assms(6) document returns_result_eq by force
   qed
 qed
 
 lemma get_scdom_component_ptrs_same_scope_component:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "ptr' \<in> set sc"
   shows "h \<turnstile> get_scdom_component ptr' \<rightarrow>\<^sub>r sc"
 proof -
   obtain document disc_nodes tree_order disconnected_tree_orders where
     document: "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r document"
     and disc_nodes: "h \<turnstile> get_disconnected_nodes document \<rightarrow>\<^sub>r disc_nodes"
     and tree_order: "h \<turnstile> to_tree_order (cast document) \<rightarrow>\<^sub>r tree_order"
     and disconnected_tree_orders: "h \<turnstile> map_M (to_tree_order \<circ> cast) disc_nodes \<rightarrow>\<^sub>r disconnected_tree_orders"
     and sc: "sc = tree_order @ (concat disconnected_tree_orders)"
     using assms(4)
     by(auto simp add: get_scdom_component_def elim!: bind_returns_result_E
         elim!: bind_returns_result_E2[rotated, OF get_owner_document_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         elim!: bind_returns_result_E2[rotated, OF to_tree_order_pure, rotated]
         )
   show ?thesis
   proof (cases "ptr' \<in> set tree_order")
     case True
     then have "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r document"
       by (metis assms(1) assms(2) assms(3) 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_inject document
           document_ptr_casts_commute3 document_ptr_kinds_commutes known_ptr_node_or_document
           local.get_owner_document_owner_document_in_heap local.get_root_node_document
           local.get_root_node_not_node_same local.known_ptrs_known_ptr local.to_tree_order_get_root_node
           local.to_tree_order_ptr_in_result node_ptr_no_document_ptr_cast tree_order)
     then show ?thesis
       using disc_nodes tree_order disconnected_tree_orders sc
       by(auto simp add: get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   next
     case False
     then obtain disconnected_tree_order where disconnected_tree_order:
       "ptr' \<in> set disconnected_tree_order" and "disconnected_tree_order \<in> set disconnected_tree_orders"
       using sc \<open>ptr' \<in> set sc\<close>
       by auto
     obtain root_ptr' where
       root_ptr': "root_ptr' \<in> set disc_nodes" and
       "h \<turnstile> to_tree_order (cast root_ptr') \<rightarrow>\<^sub>r disconnected_tree_order"
       using map_M_pure_E2[OF disconnected_tree_orders \<open>disconnected_tree_order \<in> set disconnected_tree_orders\<close>]
       by (metis comp_apply local.to_tree_order_pure)
     have "\<not>(\<exists>parent \<in> fset (object_ptr_kinds h). root_ptr' \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r)"
       using disc_nodes
       by (meson assms(1) assms(2) assms(3) disjoint_iff_not_equal local.get_child_nodes_ok
           local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr notin_fset
           returns_result_select_result root_ptr')
     then
     have "h \<turnstile> get_parent root_ptr' \<rightarrow>\<^sub>r None"
       using disc_nodes
       by (metis (no_types, lifting) assms(1) assms(2) assms(3) fmember.rep_eq
           local.get_parent_child_dual local.get_parent_ok local.get_parent_parent_in_heap
           local.heap_is_wellformed_disc_nodes_in_heap returns_result_select_result root_ptr'
           select_result_I2 split_option_ex)
     then have "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r cast root_ptr'"
       using \<open>h \<turnstile> to_tree_order (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_ptr') \<rightarrow>\<^sub>r disconnected_tree_order\<close> assms(1)
         assms(2) assms(3) disconnected_tree_order local.get_root_node_no_parent
         local.to_tree_order_get_root_node local.to_tree_order_ptr_in_result
       by blast
     then have "h \<turnstile> get_owner_document (cast root_ptr') \<rightarrow>\<^sub>r document"
       using assms(1) assms(2) assms(3) disc_nodes local.get_owner_document_disconnected_nodes root_ptr'
       by blast
 
     then have "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r document"
       using \<open>h \<turnstile> get_root_node ptr' \<rightarrow>\<^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 root_ptr'\<close> assms(1) assms(2) assms(3)
         local.get_root_node_same_owner_document
       by blast
     then show ?thesis
       using disc_nodes tree_order disconnected_tree_orders sc
       by(auto simp add: get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   qed
 qed
 
 lemma get_scdom_component_ok:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_scdom_component ptr)"
   using assms
   apply(auto simp add: get_scdom_component_def intro!: bind_is_OK_pure_I map_M_pure_I map_M_ok_I)[1]
   using get_owner_document_ok
      apply blast
     apply (simp add: local.get_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap)
    apply (simp add: local.get_owner_document_owner_document_in_heap local.to_tree_order_ok)
   using local.heap_is_wellformed_disc_nodes_in_heap local.to_tree_order_ok node_ptr_kinds_commutes
   by blast
 
 lemma get_scdom_component_ptr_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "ptr' \<in> set sc"
   shows "ptr' |\<in>| object_ptr_kinds h"
   apply(insert assms )
   apply(auto simp add: get_scdom_component_def elim!: bind_returns_result_E2 intro!: map_M_pure_I)[1]
   using local.to_tree_order_ptrs_in_heap apply blast
   by (metis (no_types, lifting) assms(4) assms(5) bind_returns_result_E
       get_scdom_component_ptrs_same_scope_component is_OK_returns_result_I get_scdom_component_def
       local.get_owner_document_ptr_in_heap)
 
 lemma get_scdom_component_contains_get_dom_component:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "ptr' \<in> set sc"
   obtains c where "h \<turnstile> get_dom_component ptr' \<rightarrow>\<^sub>r c" and "set c \<subseteq> set sc"
 proof -
   have "h \<turnstile> get_scdom_component ptr' \<rightarrow>\<^sub>r sc"
     using assms(1) assms(2) assms(3) assms(4) assms(5) get_scdom_component_ptrs_same_scope_component
     by blast
   then show ?thesis
     by (meson assms(1) assms(2) assms(3) assms(5) get_scdom_component_ptr_in_heap
         get_scdom_component_subset_get_dom_component is_OK_returns_result_E local.get_dom_component_ok that)
 qed
 
 lemma get_scdom_component_owner_document_same:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "ptr' \<in> set sc"
   obtains owner_document where "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document" and "cast owner_document \<in> set sc"
   using assms
   apply(auto simp add: get_scdom_component_def elim!: bind_returns_result_E2 intro!: map_M_pure_I)[1]
    apply (metis (no_types, lifting) assms(4) assms(5) document_ptr_casts_commute3
       document_ptr_document_ptr_cast get_scdom_component_contains_get_dom_component
       local.get_dom_component_ptr local.get_dom_component_root_node_same local.get_dom_component_to_tree_order
       local.get_root_node_document local.get_root_node_not_node_same local.to_tree_order_ptr_in_result
       local.to_tree_order_ptrs_in_heap node_ptr_no_document_ptr_cast)
   apply(rule map_M_pure_E2)
      apply(simp)
     apply(simp)
    apply(simp)
   by (smt assms(4) assms(5) comp_apply get_scdom_component_ptr_in_heap is_OK_returns_result_E
       local.get_owner_document_disconnected_nodes local.get_root_node_ok local.get_root_node_same_owner_document
       local.to_tree_order_get_root_node local.to_tree_order_ptr_in_result)
 
 lemma get_scdom_component_different_owner_documents:
   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"
   assumes "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document'"
   assumes "owner_document \<noteq> owner_document'"
   shows "set |h \<turnstile> get_scdom_component ptr|\<^sub>r \<inter> set |h \<turnstile> get_scdom_component ptr'|\<^sub>r = {}"
   using assms get_scdom_component_ptrs_same_owner_document
   by (smt disjoint_iff_not_equal get_scdom_component_ok is_OK_returns_result_I
       local.get_owner_document_ptr_in_heap returns_result_eq returns_result_select_result)
 
 
 lemma get_scdom_component_ptr:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r c"
   shows "ptr \<in> set c"
   using assms
   by (meson get_scdom_component_ptr_in_heap2 get_scdom_component_subset_get_dom_component
       is_OK_returns_result_E is_OK_returns_result_I local.get_dom_component_ok local.get_dom_component_ptr
       subsetD)
 end
 
 locale l_get_dom_component_get_scdom_component = l_get_owner_document_defs + l_heap_is_wellformed_defs +
   l_type_wf + l_known_ptrs + l_get_scdom_component_defs + l_get_dom_component_defs +
   assumes get_scdom_component_subset_get_dom_component:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow>
 h \<turnstile> get_dom_component ptr \<rightarrow>\<^sub>r c \<Longrightarrow> set c \<subseteq> set sc"
   assumes get_scdom_component_ptrs_same_scope_component:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow>
 ptr' \<in> set sc \<Longrightarrow> h \<turnstile> get_scdom_component ptr' \<rightarrow>\<^sub>r sc"
   assumes get_scdom_component_ptrs_same_owner_document:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow>
 ptr' \<in> set sc \<Longrightarrow> h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<Longrightarrow> h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document"
   assumes get_scdom_component_ok:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow>
 h \<turnstile> ok (get_scdom_component ptr)"
   assumes get_scdom_component_ptr_in_heap:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow>
 ptr' \<in> set sc \<Longrightarrow> ptr' |\<in>| object_ptr_kinds h"
   assumes get_scdom_component_contains_get_dom_component:
     "(\<And>c. h \<turnstile> get_dom_component ptr' \<rightarrow>\<^sub>r c \<Longrightarrow> set c \<subseteq> set sc \<Longrightarrow> thesis) \<Longrightarrow> heap_is_wellformed h \<Longrightarrow>
 type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow> ptr' \<in> set sc \<Longrightarrow> thesis"
   assumes get_scdom_component_owner_document_same:
     "(\<And>owner_document. h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document \<Longrightarrow> cast owner_document \<in> set sc \<Longrightarrow> thesis) \<Longrightarrow>
     heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc \<Longrightarrow>
 ptr' \<in> set sc \<Longrightarrow> thesis"
   assumes get_scdom_component_different_owner_documents:
     "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow> h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document \<Longrightarrow>
 h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document' \<Longrightarrow> owner_document \<noteq> owner_document' \<Longrightarrow>
 set |h \<turnstile> get_scdom_component ptr|\<^sub>r \<inter> set |h \<turnstile> get_scdom_component ptr'|\<^sub>r = {}"
 
 interpretation i_get_dom_component_get_scdom_component?: l_get_dom_component_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_owner_document
   get_disconnected_nodes get_disconnected_nodes_locs to_tree_order heap_is_wellformed parent_child_rel
   type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe get_root_node get_root_node_locs get_ancestors
   get_ancestors_locs get_element_by_id get_elements_by_class_name get_elements_by_tag_name
   by(auto simp add: l_get_dom_component_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_dom_component_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_get_dom_component_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_dom_component_get_scdom_component_is_l_get_dom_component_get_scdom_component [instances]:
   "l_get_dom_component_get_scdom_component get_owner_document heap_is_wellformed type_wf known_ptr
 known_ptrs get_scdom_component get_dom_component"
   apply(auto simp add: l_get_dom_component_get_scdom_component_def l_get_dom_component_get_scdom_component_axioms_def instances)[1]
   using get_scdom_component_subset_get_dom_component apply fast
   using get_scdom_component_ptrs_same_scope_component apply fast
   using get_scdom_component_ptrs_same_owner_document apply fast
   using get_scdom_component_ok apply fast
   using get_scdom_component_ptr_in_heap apply fast
   using get_scdom_component_contains_get_dom_component apply blast
   using get_scdom_component_owner_document_same apply blast
   using get_scdom_component_different_owner_documents apply fast
   done
 
 
 subsubsection \<open>get\_child\_nodes\<close>
 
 locale l_get_scdom_component_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_child_nodes_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
   assumes "child \<in> set children"
   shows "cast child \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
   apply(auto)[1]
    apply (meson assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) contra_subsetD
       get_scdom_component_ptrs_same_scope_component get_scdom_component_subset_get_dom_component
       is_OK_returns_result_E local.get_child_nodes_is_strongly_dom_component_safe local.get_dom_component_ok
       local.get_dom_component_ptr local.heap_is_wellformed_children_in_heap node_ptr_kinds_commutes)
   by (meson assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
       get_scdom_component_contains_get_dom_component is_OK_returns_result_E is_OK_returns_result_I
       get_child_nodes_is_strongly_dom_component_safe local.get_child_nodes_ptr_in_heap
       local.get_dom_component_ok local.get_dom_component_ptr set_rev_mp)
 
 lemma get_child_nodes_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} (cast ` set children) h h'"
 proof -
   have "h = h'"
     using assms(5)
     by (meson local.get_child_nodes_pure pure_returns_heap_eq)
   then show ?thesis
     using assms
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def)[1]
     by (smt Int_absorb2 finite_set_in get_child_nodes_is_strongly_scdom_component_safe_step in_mono
         is_OK_returns_result_I local.get_child_nodes_ptr_in_heap local.get_dom_component_ok
         local.get_dom_component_ptr local.get_scdom_component_impl local.get_scdom_component_ok
         local.get_scdom_component_ptr_in_heap local.get_scdom_component_subset_get_dom_component
         returns_result_select_result subsetI)
 qed
 end
 
 interpretation i_get_scdom_component_get_child_nodes?: l_get_scdom_component_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe
   get_dom_component is_strongly_dom_component_safe is_weakly_dom_component_safe get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs get_child_nodes
   get_child_nodes_locs get_root_node get_root_node_locs get_ancestors get_ancestors_locs get_element_by_id
   get_elements_by_class_name get_elements_by_tag_name first_in_tree_order get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_parent\<close>
 
 locale l_get_scdom_component_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma get_parent_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_parent ptr' \<rightarrow>\<^sub>r Some parent"
   shows "parent \<in> set sc \<longleftrightarrow> cast ptr' \<in> set sc"
   by (meson assms(1) assms(2) assms(3) assms(4) assms(5) contra_subsetD
       get_scdom_component_contains_get_dom_component local.get_dom_component_ptr
       local.get_parent_is_strongly_dom_component_safe_step)
 
 lemma get_parent_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r Some parent"
   assumes "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {cast node_ptr} {parent} h h'"
 proof -
   have "h = h'"
     using assms(5)
     by (meson local.get_parent_pure pure_returns_heap_eq)
   then show ?thesis
     using assms
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def)[1]
     by (smt IntI finite_set_in in_mono local.get_dom_component_ok local.get_dom_component_ptr
         local.get_parent_is_strongly_dom_component_safe_step local.get_parent_parent_in_heap
         local.get_scdom_component_impl local.get_scdom_component_ok local.get_scdom_component_subset_get_dom_component
         local.to_tree_order_ok local.to_tree_order_parent local.to_tree_order_ptr_in_result
         local.to_tree_order_ptrs_in_heap returns_result_select_result)
 qed
 end
 
 interpretation i_get_scdom_component_get_parent?: l_get_scdom_component_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs get_child_nodes get_child_nodes_locs
   get_root_node get_root_node_locs get_ancestors get_ancestors_locs get_element_by_id
   get_elements_by_class_name get_elements_by_tag_name first_in_tree_order get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 locale l_get_scdom_component_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma get_root_node_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_root_node ptr' \<rightarrow>\<^sub>r root"
   shows "root \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
   by (meson assms(1) assms(2) assms(3) assms(4) assms(5) contra_subsetD
       get_scdom_component_contains_get_dom_component local.get_dom_component_ptr
       local.get_root_node_is_strongly_dom_component_safe_step)
 
 lemma get_root_node_is_strongly_scdom_component_safe:
   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 "h \<turnstile> get_root_node ptr \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} {root} h h'"
 proof -
   have "h = h'"
     using assms(5)
     by (meson local.get_root_node_pure pure_returns_heap_eq)
   then show ?thesis
     using assms
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def)[1]
     by (smt Int_iff finite_set_in is_OK_returns_result_I local.get_dom_component_ok
         local.get_dom_component_ptr local.get_root_node_is_strongly_dom_component_safe_step
         local.get_root_node_ptr_in_heap local.get_scdom_component_impl local.get_scdom_component_ok
         local.get_scdom_component_subset_get_dom_component returns_result_select_result subset_eq)
 qed
 end
 
 interpretation i_get_scdom_component_get_root_node?: l_get_scdom_component_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs get_child_nodes
   get_child_nodes_locs get_root_node get_root_node_locs get_ancestors get_ancestors_locs
   get_element_by_id get_elements_by_class_name get_elements_by_tag_name first_in_tree_order
   get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_element\_by\_id\<close>
 
 locale l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma get_element_by_id_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_element_by_id ptr' idd \<rightarrow>\<^sub>r Some result"
   shows "cast result \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
   by (meson assms(1) assms(2) assms(3) assms(4) assms(5) contra_subsetD
       get_element_by_id_is_strongly_dom_component_safe_step get_scdom_component_contains_get_dom_component
       local.get_dom_component_ptr)
 
 lemma get_element_by_id_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_element_by_id ptr idd \<rightarrow>\<^sub>r Some result"
   assumes "h \<turnstile> get_element_by_id ptr idd \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} {cast result} h h'"
 proof -
   have "h = h'"
     using assms(5)
     by(auto simp add: preserved_def get_element_by_id_def first_in_tree_order_def
         elim!: bind_returns_heap_E2 intro!: map_filter_M_pure bind_pure_I
         split: option.splits list.splits)
   have "ptr |\<in>| object_ptr_kinds h"
     using assms(4)
     apply(auto simp add: get_element_by_id_def)[1]
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) bind_is_OK_E is_OK_returns_result_I
         local.first_in_tree_order_def local.to_tree_order_ptr_in_result local.to_tree_order_ptrs_in_heap)
   obtain to where to: "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
     by (meson \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.to_tree_order_ok)
   then have "cast result \<in> set to"
     using assms(4) local.get_element_by_id_result_in_tree_order by auto
   obtain c where c: "h \<turnstile> a_get_scdom_component ptr \<rightarrow>\<^sub>r c"
     using \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) local.get_scdom_component_impl
       local.get_scdom_component_ok
     by blast
 
   then show ?thesis
     using assms \<open>h = h'\<close>
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def
         get_element_by_id_def first_in_tree_order_def elim!: bind_returns_result_E2
         intro!: map_filter_M_pure bind_pure_I split: option.splits list.splits)[1]
     by (smt IntI \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(4) finite_set_in
         get_element_by_id_is_strongly_scdom_component_safe_step local.get_dom_component_ok
         local.get_dom_component_ptr local.get_scdom_component_impl
         local.get_scdom_component_subset_get_dom_component returns_result_select_result select_result_I2
         subsetD)
 qed
 end
 
 interpretation i_get_scdom_component_get_element_by_id?: l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs get_child_nodes
   get_child_nodes_locs get_root_node get_root_node_locs get_ancestors get_ancestors_locs
   get_element_by_id get_elements_by_class_name get_elements_by_tag_name first_in_tree_order
   get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_elements\_by\_class\_name\<close>
 
 locale l_get_scdom_component_get_elements_by_class_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_elements_by_class_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma get_elements_by_class_name_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_elements_by_class_name ptr' idd \<rightarrow>\<^sub>r results"
   assumes "result \<in> set results"
   shows "cast result \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
   by (meson assms local.get_dom_component_ptr
       local.get_elements_by_class_name_is_strongly_dom_component_safe_step
       local.get_scdom_component_contains_get_dom_component subsetD)
 
 
 lemma get_elements_by_class_name_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_elements_by_class_name ptr idd \<rightarrow>\<^sub>r results"
   assumes "h \<turnstile> get_elements_by_class_name ptr idd \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} (cast ` set results) h h'"
 proof -
   have "h = h'"
     using assms(5)
     by (meson local.get_elements_by_class_name_pure pure_returns_heap_eq)
   have "ptr |\<in>| object_ptr_kinds h"
     using assms(4)
     apply(auto simp add: get_elements_by_class_name_def)[1]
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) bind_is_OK_E is_OK_returns_result_I
         local.first_in_tree_order_def local.to_tree_order_ptr_in_result local.to_tree_order_ptrs_in_heap)
   obtain to where to: "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
     by (meson \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.to_tree_order_ok)
   then have "cast ` set results \<subseteq> set to"
     using assms(4) local.get_elements_by_class_name_result_in_tree_order by auto
   obtain c where c: "h \<turnstile> a_get_scdom_component ptr \<rightarrow>\<^sub>r c"
     using \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) local.get_scdom_component_impl
       local.get_scdom_component_ok by blast
 
   then show ?thesis
     using assms \<open>h = h'\<close>
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def
         get_element_by_id_def first_in_tree_order_def elim!: bind_returns_result_E2 intro!: map_filter_M_pure
         bind_pure_I split: option.splits list.splits)[1]
     by (smt IntI \<open>ptr |\<in>| object_ptr_kinds h\<close> finite_set_in
         get_elements_by_class_name_is_strongly_scdom_component_safe_step local.get_dom_component_ok
         local.get_dom_component_ptr local.get_scdom_component_impl
         local.get_scdom_component_subset_get_dom_component returns_result_select_result select_result_I2 subsetD)
 qed
 end
 
 interpretation i_get_scdom_component_get_elements_by_class_name?: l_get_scdom_component_get_elements_by_class_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe get_disconnected_nodes
   get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs get_child_nodes get_child_nodes_locs
   get_root_node get_root_node_locs get_ancestors get_ancestors_locs get_element_by_id
   get_elements_by_class_name get_elements_by_tag_name first_in_tree_order get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_elements_by_class_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_elements\_by\_tag\_name\<close>
 
 locale l_get_scdom_component_get_elements_by_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_elements_by_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma get_elements_by_tag_name_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_elements_by_tag_name ptr' idd \<rightarrow>\<^sub>r results"
   assumes "result \<in> set results"
   shows "cast result \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
   by (meson assms local.get_dom_component_ptr
       local.get_elements_by_tag_name_is_strongly_dom_component_safe_step
       local.get_scdom_component_contains_get_dom_component subsetD)
 
 
 lemma get_elements_by_tag_name_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_elements_by_tag_name ptr idd \<rightarrow>\<^sub>r results"
   assumes "h \<turnstile> get_elements_by_tag_name ptr idd \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} (cast ` set results) h h'"
 proof -
   have "h = h'"
     using assms(5)
     by (meson local.get_elements_by_tag_name_pure pure_returns_heap_eq)
   have "ptr |\<in>| object_ptr_kinds h"
     using assms(4)
     apply(auto simp add: get_elements_by_tag_name_def)[1]
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) bind_is_OK_E is_OK_returns_result_I
         local.first_in_tree_order_def local.to_tree_order_ptr_in_result local.to_tree_order_ptrs_in_heap)
   obtain to where to: "h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to"
     by (meson \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.to_tree_order_ok)
   then have "cast ` set results \<subseteq> set to"
     using assms(4) local.get_elements_by_tag_name_result_in_tree_order by auto
   obtain c where c: "h \<turnstile> a_get_scdom_component ptr \<rightarrow>\<^sub>r c"
     using \<open>ptr |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) local.get_scdom_component_impl
       local.get_scdom_component_ok by blast
 
   then show ?thesis
     using assms \<open>h = h'\<close>
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def
         get_element_by_id_def first_in_tree_order_def elim!: bind_returns_result_E2 intro!:
         map_filter_M_pure bind_pure_I split: option.splits list.splits)[1]
     by (smt IntI \<open>ptr |\<in>| object_ptr_kinds h\<close> finite_set_in
         get_elements_by_tag_name_is_strongly_scdom_component_safe_step local.get_dom_component_ok
         local.get_dom_component_ptr local.get_scdom_component_impl
         local.get_scdom_component_subset_get_dom_component returns_result_select_result select_result_I2
         subsetD)
 qed
 end
 
 interpretation i_get_scdom_component_get_elements_by_tag_name?:
   l_get_scdom_component_get_elements_by_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe
   get_dom_component is_strongly_dom_component_safe is_weakly_dom_component_safe
   get_disconnected_nodes get_disconnected_nodes_locs to_tree_order get_parent get_parent_locs
   get_child_nodes get_child_nodes_locs get_root_node get_root_node_locs get_ancestors
   get_ancestors_locs get_element_by_id get_elements_by_class_name get_elements_by_tag_name
   first_in_tree_order get_attribute get_attribute_locs
   by(auto simp add: l_get_scdom_component_get_elements_by_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_get_element_by_id\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>remove\_child\<close>
 
 locale l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_get_owner_document_wf +
   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 parent_child_rel
 begin
 lemma remove_child_is_component_unsafe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component ptr'|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast |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)|\<^sub>r)|\<^sub>r"
     (* assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast child)|\<^sub>r" *)
   shows "preserved (get_M ptr getter) h h'"
 proof -
   have "ptr \<noteq> ptr'"
     using assms(5)
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) is_OK_returns_heap_I
         is_OK_returns_result_E local.get_dom_component_ok local.get_dom_component_ptr
         local.remove_child_ptr_in_heap select_result_I2)
 
   obtain owner_document 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"
     by (meson assms(1) assms(2) assms(3) assms(4) is_OK_returns_result_E local.get_owner_document_ok
         local.remove_child_child_in_heap node_ptr_kinds_commutes)
   then
   obtain c where "h \<turnstile> get_dom_component (cast owner_document) \<rightarrow>\<^sub>r c"
     using get_dom_component_ok owner_document assms(1) assms(2) assms(3)
     by (meson document_ptr_kinds_commutes get_owner_document_owner_document_in_heap select_result_I)
   then
   have "ptr \<noteq> cast owner_document"
     using assms(6) assms(1) assms(2) assms(3) local.get_dom_component_ptr owner_document
     by auto
 
   show ?thesis
     using remove_child_writes assms(4)
     apply(rule reads_writes_preserved2)
     apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: option.splits)[1]
          apply (metis \<open>ptr \<noteq> ptr'\<close> document_ptr_casts_commute3 get_M_Mdocument_preserved3)
         apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
        apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
       apply (metis \<open>ptr \<noteq> ptr'\<close> element_ptr_casts_commute3 get_M_Element_preserved8)
      apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
     apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
     done
 qed
 
 lemma remove_child_is_strongly_dom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component ptr'|\<^sub>r"
     (* assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast |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)|\<^sub>r)|\<^sub>r" *)
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast child)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   obtain sc where sc: "h \<turnstile> get_scdom_component ptr' \<rightarrow>\<^sub>r sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) assms(4) is_OK_returns_heap_I local.remove_child_ptr_in_heap
         returns_result_select_result)
 
   have "child |\<in>| node_ptr_kinds h"
     using assms(4) remove_child_child_in_heap by blast
   then
   obtain child_sc where child_sc: "h \<turnstile> get_scdom_component (cast child) \<rightarrow>\<^sub>r child_sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) node_ptr_kinds_commutes select_result_I)
   then obtain owner_document 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"
     by (meson \<open>child |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) contra_subsetD
         get_scdom_component_owner_document_same is_OK_returns_result_E
         get_scdom_component_subset_get_dom_component local.get_dom_component_ok local.get_dom_component_ptr
         node_ptr_kinds_commutes)
   then have "h \<turnstile> get_scdom_component (cast owner_document) \<rightarrow>\<^sub>r child_sc"
     using child_sc
     by (smt \<open>child |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) contra_subsetD
         get_scdom_component_subset_get_dom_component get_scdom_component_owner_document_same
         get_scdom_component_ptrs_same_scope_component local.get_dom_component_ok local.get_dom_component_ptr
         node_ptr_kinds_commutes returns_result_select_result select_result_I2)
 
   have "ptr \<notin> set |h \<turnstile> get_dom_component ptr'|\<^sub>r"
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) assms(5) contra_subsetD
         get_scdom_component_subset_get_dom_component is_OK_returns_heap_I local.get_dom_component_ok
         local.remove_child_ptr_in_heap returns_result_select_result sc select_result_I2)
 
   moreover have "ptr \<notin> set |h \<turnstile> get_scdom_component (cast |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)|\<^sub>r)|\<^sub>r"
     using get_scdom_component_owner_document_same get_scdom_component_ptrs_same_scope_component
     by (metis (no_types, lifting)
         \<open>h \<turnstile> get_scdom_component (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) \<rightarrow>\<^sub>r child_sc\<close> assms(6) child_sc
         owner_document select_result_I2)
   have "ptr \<notin> set |h \<turnstile> get_dom_component (cast |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)|\<^sub>r)|\<^sub>r"
     using get_scdom_component_owner_document_same
     by (metis (no_types, lifting)
         \<open>h \<turnstile> get_scdom_component (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) \<rightarrow>\<^sub>r child_sc\<close>
         \<open>ptr \<notin> set |h \<turnstile> get_scdom_component (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 |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)|\<^sub>r)|\<^sub>r\<close>
         assms(1) assms(2) assms(3) contra_subsetD document_ptr_kinds_commutes get_scdom_component_subset_get_dom_component
         is_OK_returns_result_E local.get_dom_component_ok local.get_owner_document_owner_document_in_heap owner_document
         select_result_I2)
   ultimately show ?thesis
     using assms(1) assms(2) assms(3) assms(4) remove_child_is_component_unsafe by blast
 qed
 
 
 
 lemma remove_child_is_strongly_dom_component_safe:
   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 "is_strongly_scdom_component_safe {ptr, cast child} {} h 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 object_ptr_kinds_eq3: "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)
   then have object_ptr_kinds_eq: "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq2: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     using select_result_eq by force
   then have node_ptr_kinds_eq2: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by auto
   then have node_ptr_kinds_eq3: "node_ptr_kinds h = node_ptr_kinds h'"
     using node_ptr_kinds_M_eq by auto
   have document_ptr_kinds_eq2: "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto
   then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'"
     using document_ptr_kinds_M_eq by auto
   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 disconnected_nodes_eq: "\<And>document_ptr disconnected_nodes. document_ptr \<noteq> owner_document
          \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes
              = h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disconnected_nodes"
     apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(4)])
     unfolding remove_child_locs_def
     using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers
     by (metis (no_types, lifting) Un_iff owner_document select_result_I2)
   then have disconnected_nodes_eq2:
     "\<And>document_ptr. document_ptr \<noteq> owner_document
     \<Longrightarrow> |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes document_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 "known_ptrs h'"
     using object_ptr_kinds_eq3 known_ptrs_preserved \<open>known_ptrs h\<close> by blast
 
   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 assms(2)
     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_child_nodes_writes h']
     using  set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   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_h2: "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     using owner_document assms(4) h2 disconnected_nodes_h
     apply (auto simp add: remove_child_def  split: if_splits)[1]
     apply(drule bind_returns_heap_E2)
       apply(auto split: if_splits)[1]
      apply(simp)
     by(auto simp add: local.set_disconnected_nodes_get_disconnected_nodes split: if_splits)
   then have disconnected_nodes_h': "h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r child # disconnected_nodes_h"
     apply(rule reads_writes_separate_forwards[OF get_disconnected_nodes_reads set_child_nodes_writes h'])
     by (simp add: set_child_nodes_get_disconnected_nodes)
 
   moreover have "a_acyclic_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
   proof (standard, safe)
     fix parent child
     assume a1: "(parent, child) \<in> parent_child_rel h'"
     then show "(parent, child) \<in> parent_child_rel h"
     proof (cases "parent = ptr")
       case True
       then show ?thesis
         using a1 remove_child_removes_parent[OF assms(1) assms(4)] children_h children_h'
           get_child_nodes_ptr_in_heap
         apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1]
         by (metis imageI notin_set_remove1)
     next
       case False
       then show ?thesis
         using a1
         by(auto simp add: parent_child_rel_def object_ptr_kinds_eq3 children_eq2)
     qed
   qed
   then have "a_acyclic_heap h'"
     using \<open>a_acyclic_heap h\<close> acyclic_heap_def acyclic_subset by blast
 
   moreover have "a_all_ptrs_in_heap h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3 disconnected_nodes_eq)[1]
      apply (metis (no_types, lifting) \<open>type_wf h'\<close> assms local.get_child_nodes_ok local.known_ptrs_known_ptr
         local.remove_child_children_subset notin_fset object_ptr_kinds_eq3 returns_result_select_result subset_code(1))
     apply (metis (no_types, lifting) assms(4) disconnected_nodes_eq2 disconnected_nodes_h disconnected_nodes_h'
         document_ptr_kinds_eq3 finite_set_in local.remove_child_child_in_heap node_ptr_kinds_eq3 select_result_I2
         set_ConsD subset_code(1))
     done
   moreover have "a_owner_document_valid h"
     using assms(1)  by (simp add: heap_is_wellformed_def)
   then have "a_owner_document_valid h'"
     apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3
         node_ptr_kinds_eq3)[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 h' \<and>
 node_ptr \<in> set |h \<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 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"
     proof (cases "node_ptr = child")
       case True
       show ?thesis
         apply(rule exI[where x=owner_document])
         using children_eq2 disconnected_nodes_eq2 children_h children_h' disconnected_nodes_h' True
         by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I
             list.set_intros(1) select_result_I2)
     next
       case False
       then show ?thesis
         using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h
           disconnected_nodes_h'
         apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1]
         by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2))
     qed
   qed
 
   moreover
   {
     have h0: "a_distinct_lists h"
       using assms(1)  by (simp add: heap_is_wellformed_def)
     moreover have ha1: "(\<Union>x\<in>set |h \<turnstile> object_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_child_nodes x|\<^sub>r)
                  \<inter> (\<Union>x\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r. set |h \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       using \<open>a_distinct_lists h\<close>
       unfolding a_distinct_lists_def
       by(auto)
     have ha2: "ptr |\<in>| object_ptr_kinds h"
       using children_h get_child_nodes_ptr_in_heap by blast
     have ha3: "child \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r"
       using child_in_children_h children_h
       by(simp)
     have child_not_in: "\<And>document_ptr. document_ptr |\<in>| document_ptr_kinds h
                           \<Longrightarrow> child \<notin> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
       using ha1 ha2 ha3
       apply(simp)
       using IntI by fastforce
     moreover have "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: object_ptr_kinds_M_defs)
     moreover have "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       apply(rule select_result_I)
       by(auto simp add: document_ptr_kinds_M_defs)
     ultimately have "a_distinct_lists h'"
     proof(simp (no_asm) add: a_distinct_lists_def, safe)
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
 
       assume 1: "a_distinct_lists h"
         and 3: "distinct |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
       have 4: "distinct (concat ((map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r)))"
         using 1 by(auto simp add: a_distinct_lists_def)
       show "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                      (sorted_list_of_set (fset (object_ptr_kinds h')))))"
       proof(rule distinct_concat_map_I[OF 3[unfolded object_ptr_kinds_eq2], simplified])
         fix x
         assume 5: "x |\<in>| object_ptr_kinds h'"
         then have 6: "distinct |h \<turnstile> get_child_nodes x|\<^sub>r"
           using 4 distinct_concat_map_E object_ptr_kinds_eq2 by fastforce
         obtain children where children: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children"
           and distinct_children: "distinct children"
           by (metis "5" "6" assms get_child_nodes_ok local.known_ptrs_known_ptr
               object_ptr_kinds_eq3 select_result_I)
         obtain children' where children': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children'"
           using children children_eq children_h' by fastforce
         then have "distinct children'"
         proof (cases "ptr = x")
           case True
           then show ?thesis
             using children distinct_children children_h children_h'
             by (metis children' distinct_remove1 returns_result_eq)
         next
           case False
           then show ?thesis
             using children distinct_children children_eq[OF False]
             using children' distinct_lists_children h0
             using select_result_I2 by fastforce
         qed
 
         then show "distinct |h' \<turnstile> get_child_nodes x|\<^sub>r"
           using children' by(auto simp add: )
       next
         fix x y
         assume 5: "x |\<in>| object_ptr_kinds h'" and 6: "y |\<in>| object_ptr_kinds h'" and 7: "x \<noteq> y"
         obtain children_x where children_x: "h \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x"
           by (metis "5" assms get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_y where children_y: "h \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y"
           by (metis "6" assms get_child_nodes_ok is_OK_returns_result_E
               local.known_ptrs_known_ptr object_ptr_kinds_eq3)
         obtain children_x' where children_x': "h' \<turnstile> get_child_nodes x \<rightarrow>\<^sub>r children_x'"
           using children_eq children_h' children_x by fastforce
         obtain children_y' where children_y': "h' \<turnstile> get_child_nodes y \<rightarrow>\<^sub>r children_y'"
           using children_eq children_h' children_y by fastforce
         have "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r) |h \<turnstile> object_ptr_kinds_M|\<^sub>r))"
           using h0 by(auto simp add: a_distinct_lists_def)
         then have 8: "set children_x \<inter> set children_y = {}"
           using "7" assms(1) children_x children_y local.heap_is_wellformed_one_parent by blast
         have "set children_x' \<inter> set children_y' = {}"
         proof (cases "ptr = x")
           case True
           then have "ptr \<noteq> y"
             by(simp add: 7)
           have "children_x' = remove1 child children_x"
             using children_h children_h' children_x children_x' True returns_result_eq by fastforce
           moreover have "children_y' = children_y"
             using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
           ultimately show ?thesis
             using 8 set_remove1_subset by fastforce
         next
           case False
           then show ?thesis
           proof (cases "ptr = y")
             case True
             have "children_y' = remove1 child children_y"
               using children_h children_h' children_y children_y' True returns_result_eq by fastforce
             moreover have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             ultimately show ?thesis
               using 8 set_remove1_subset by fastforce
           next
             case False
             have "children_x' = children_x"
               using children_x children_x' children_eq[OF \<open>ptr \<noteq> x\<close>] by auto
             moreover have "children_y' = children_y"
               using children_y children_y' children_eq[OF \<open>ptr \<noteq> y\<close>] by auto
             ultimately show ?thesis
               using 8 by simp
           qed
         qed
         then show "set |h' \<turnstile> get_child_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_child_nodes y|\<^sub>r = {}"
           using children_x' children_y'
           by (metis (no_types, lifting) select_result_I2)
       qed
     next
       assume 2: "distinct |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
       then have 4: "distinct  (sorted_list_of_set (fset (document_ptr_kinds h')))"
         by simp
       have 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')))))"
         using h0
         by(simp add: a_distinct_lists_def document_ptr_kinds_eq3)
 
       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[OF 4[unfolded document_ptr_kinds_eq3]])
         fix x
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
         have 5: "distinct |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
           using distinct_lists_disconnected_nodes[OF h0] 4 get_disconnected_nodes_ok
           by (simp add: assms document_ptr_kinds_eq3 select_result_I)
         show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
         proof (cases "x = owner_document")
           case True
           have "child \<notin> set |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using child_not_in  document_ptr_kinds_eq2 "4" by fastforce
           moreover have "|h' \<turnstile> get_disconnected_nodes x|\<^sub>r = child # |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
             using disconnected_nodes_h' disconnected_nodes_h unfolding True
             by(simp)
           ultimately show ?thesis
             using 5 unfolding True
             by simp
         next
           case False
           show ?thesis
             using "5" False disconnected_nodes_eq2 by auto
         qed
       next
         fix x y
         assume 4: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
           and 5: "y \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))" and "x \<noteq> y"
         obtain disc_nodes_x where disc_nodes_x: "h \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y where disc_nodes_y: "h \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of y] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_x' where disc_nodes_x': "h' \<turnstile> get_disconnected_nodes x \<rightarrow>\<^sub>r disc_nodes_x'"
           using 4 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of x] document_ptr_kinds_eq2
           by auto
         obtain disc_nodes_y' where disc_nodes_y': "h' \<turnstile> get_disconnected_nodes y \<rightarrow>\<^sub>r disc_nodes_y'"
           using 5 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of y] document_ptr_kinds_eq2
           by auto
         have "distinct
                (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h \<turnstile> document_ptr_kinds_M|\<^sub>r))"
           using h0 by (simp add: a_distinct_lists_def)
         then have 6: "set disc_nodes_x \<inter> set disc_nodes_y = {}"
           using \<open>x \<noteq> y\<close> assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent
           by blast
 
         have "set disc_nodes_x' \<inter> set disc_nodes_y' = {}"
         proof (cases "x = owner_document")
           case True
           then have "y \<noteq> owner_document"
             using \<open>x \<noteq> y\<close> by simp
           then have "disc_nodes_y' = disc_nodes_y"
             using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y'
             by auto
           have "disc_nodes_x' = child # disc_nodes_x"
             using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h returns_result_eq
             by fastforce
           have "child \<notin> set disc_nodes_y"
             using child_not_in  disc_nodes_y 5
             using document_ptr_kinds_eq2  by fastforce
           then show ?thesis
             apply(unfold \<open>disc_nodes_x' = child # disc_nodes_x\<close> \<open>disc_nodes_y' = disc_nodes_y\<close>)
             using 6 by auto
         next
           case False
           then show ?thesis
           proof (cases "y = owner_document")
             case True
             then have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x' by auto
             have "disc_nodes_y' = child # disc_nodes_y"
               using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h returns_result_eq
               by fastforce
             have "child \<notin> set disc_nodes_x"
               using child_not_in  disc_nodes_x 4
               using document_ptr_kinds_eq2  by fastforce
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = child # disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           next
             case False
             have "disc_nodes_x' = disc_nodes_x"
               using disconnected_nodes_eq[OF \<open>x \<noteq> owner_document\<close>] disc_nodes_x disc_nodes_x' by auto
             have "disc_nodes_y' = disc_nodes_y"
               using disconnected_nodes_eq[OF \<open>y \<noteq> owner_document\<close>] disc_nodes_y disc_nodes_y' by auto
             then show ?thesis
               apply(unfold \<open>disc_nodes_y' = disc_nodes_y\<close> \<open>disc_nodes_x' = disc_nodes_x\<close>)
               using 6 by auto
           qed
         qed
         then show "set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
           using disc_nodes_x' disc_nodes_y' by auto
       qed
     next
       fix x xa xb
       assume 1: "xa \<in> fset (object_ptr_kinds h')"
         and 2: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 3: "xb \<in> fset (document_ptr_kinds h')"
         and 4: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       obtain disc_nodes where disc_nodes: "h \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h\<close>, of xb] document_ptr_kinds_eq2 by auto
       obtain disc_nodes' where disc_nodes': "h' \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r disc_nodes'"
         using 3 get_disconnected_nodes_ok[OF \<open>type_wf h'\<close>, of xb]  document_ptr_kinds_eq2 by auto
 
       obtain children where children: "h \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children"
         by (metis "1" assms finite_set_in get_child_nodes_ok is_OK_returns_result_E
             local.known_ptrs_known_ptr object_ptr_kinds_eq3)
       obtain children' where children': "h' \<turnstile> get_child_nodes xa \<rightarrow>\<^sub>r children'"
         using children children_eq children_h' by fastforce
       have "\<And>x. x \<in> set |h \<turnstile> get_child_nodes xa|\<^sub>r \<Longrightarrow> x \<in> set |h \<turnstile> get_disconnected_nodes xb|\<^sub>r \<Longrightarrow> False"
         using 1 3
         apply(fold \<open> object_ptr_kinds h =  object_ptr_kinds h'\<close>)
         apply(fold \<open> document_ptr_kinds h =  document_ptr_kinds h'\<close>)
         using children disc_nodes h0 apply(auto simp add: a_distinct_lists_def)[1]
         by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2)
       then have 5: "\<And>x. x \<in> set children \<Longrightarrow> x \<in> set disc_nodes \<Longrightarrow> False"
         using children disc_nodes  by fastforce
       have 6: "|h' \<turnstile> get_child_nodes xa|\<^sub>r = children'"
         using children' by simp
       have 7: "|h' \<turnstile> get_disconnected_nodes xb|\<^sub>r = disc_nodes'"
         using disc_nodes' by simp
       have "False"
       proof (cases "xa = ptr")
         case True
         have "distinct children_h"
           using children_h distinct_lists_children h0 \<open>known_ptr ptr\<close> by blast
         have "|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h"
           using children_h'
-          bysimp
+          by simp
         have "children = children_h"
           using True children children_h by auto
         show ?thesis
           using disc_nodes' children' 5 2 4 children_h \<open>distinct children_h\<close> disconnected_nodes_h'
           apply(auto simp add: 6 7
               \<open>xa = ptr\<close> \<open>|h' \<turnstile> get_child_nodes ptr|\<^sub>r = remove1 child children_h\<close> \<open>children = children_h\<close>)[1]
           by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h
               select_result_I2 set_ConsD)
       next
         case False
         have "children' = children"
           using children' children children_eq[OF False[symmetric]]
           by auto
         then show ?thesis
         proof (cases "xb = owner_document")
           case True
           then show ?thesis
             using disc_nodes disconnected_nodes_h disconnected_nodes_h'
             using "2" "4" "5" "6" "7" False \<open>children' = children\<close> assms(1) child_in_children_h
               child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap
               list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD
             by (metis (no_types, opaque_lifting) assms)
         next
           case False
           then show ?thesis
             using "2" "4" "5" "6" "7" \<open>children' = children\<close> disc_nodes disc_nodes'
               disconnected_nodes_eq returns_result_eq
             by metis
         qed
       qed
       then show "x \<in> {}"
         by simp
     qed
   }
 
   ultimately have "heap_is_wellformed h'"
     using heap_is_wellformed_def by blast
 
   show ?thesis
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def object_ptr_kinds_eq3)[1]
     using assms(1) assms(2) assms(3) assms(4) local.get_scdom_component_impl
       remove_child_is_strongly_dom_component_safe_step
     by blast
 qed
 end
 
 interpretation i_get_scdom_component_remove_child?: l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe to_tree_order get_parent
   get_parent_locs get_child_nodes get_child_nodes_locs get_root_node get_root_node_locs get_ancestors
   get_ancestors_locs get_disconnected_nodes get_disconnected_nodes_locs get_element_by_id
   get_elements_by_class_name get_elements_by_tag_name set_child_nodes set_child_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs remove_child remove_child_locs remove
   by(auto simp add: l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 
 subsubsection \<open>adopt\_node\<close>
 
 locale l_get_scdom_component_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_adopt_node_wf +
   l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf +
   l_get_scdom_component\<^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 +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma adopt_node_is_component_unsafe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> adopt_node document_ptr node_ptr \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast document_ptr)|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast node_ptr)|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast |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 node_ptr)|\<^sub>r)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   obtain owner_document 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 node_ptr) \<rightarrow>\<^sub>r owner_document"
     using assms(4) local.adopt_node_def by auto
   then
   obtain c where "h \<turnstile> get_dom_component (cast owner_document) \<rightarrow>\<^sub>r c"
     using get_dom_component_ok assms(1) assms(2) assms(3) get_owner_document_owner_document_in_heap
     by (meson document_ptr_kinds_commutes select_result_I)
   then
   have "ptr \<noteq> cast owner_document"
     using assms(6) assms(1) assms(2) assms(3) local.get_dom_component_ptr owner_document
     by (metis (no_types, lifting) assms(7) select_result_I2)
 
   have "document_ptr |\<in>| document_ptr_kinds h"
     using adopt_node_document_in_heap assms(1) assms(2) assms(3) assms(4) by auto
   then
   have "ptr \<noteq> cast document_ptr"
     using assms(5)
     using assms(1) assms(2) assms(3) local.get_dom_component_ptr get_dom_component_ok
     by (meson document_ptr_kinds_commutes returns_result_select_result)
 
   have "\<And>parent. |h \<turnstile> get_parent node_ptr|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr"
     by (metis assms(1) assms(2) assms(3) assms(6) is_OK_returns_result_I local.get_dom_component_ok
         local.get_dom_component_parent_inside local.get_dom_component_ptr local.get_owner_document_ptr_in_heap
         local.get_parent_ok node_ptr_kinds_commutes owner_document returns_result_select_result)
 
   show ?thesis
     using adopt_node_writes assms(4)
     apply(rule reads_writes_preserved2)
     apply(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_locs_def set_disconnected_nodes_locs_def all_args_def)[1]
                     apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
                    apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
                   apply(drule \<open>\<And>parent. |h \<turnstile> get_parent node_ptr|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>)[1] apply (metis element_ptr_casts_commute3 get_M_Element_preserved8 is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if)
                  apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
                 apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
                apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
               apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
              apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
             apply(drule \<open>\<And>parent. |h \<turnstile> get_parent node_ptr|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>)[1] apply (metis document_ptr_casts_commute3 get_M_Mdocument_preserved3)
            apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
           apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
          apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
         apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
        apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
       apply(drule \<open>\<And>parent. |h \<turnstile> get_parent node_ptr|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>)[1]
       apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
      apply (metis \<open>ptr \<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 document_ptr\<close> get_M_Mdocument_preserved3)
     apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close> get_M_Mdocument_preserved3 owner_document select_result_I2)
     done
 qed
 
 lemma adopt_node_is_strongly_dom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> adopt_node document_ptr node_ptr \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast document_ptr)|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast node_ptr)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   have "document_ptr |\<in>| document_ptr_kinds h"
     by (meson assms(1) assms(2) assms(3) assms(4) is_OK_returns_heap_I local.adopt_node_document_in_heap)
   then
   obtain sc where sc: "h \<turnstile> get_scdom_component (cast document_ptr) \<rightarrow>\<^sub>r sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) document_ptr_kinds_commutes returns_result_select_result)
 
   have "node_ptr |\<in>| node_ptr_kinds h"
     using assms(4)
     by (meson is_OK_returns_heap_I local.adopt_node_child_in_heap)
   then
   obtain child_sc where child_sc: "h \<turnstile> get_scdom_component (cast node_ptr) \<rightarrow>\<^sub>r child_sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E node_ptr_kinds_commutes)
 
   then obtain owner_document where owner_document: "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document"
     by (meson \<open>node_ptr |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) contra_subsetD
         get_scdom_component_owner_document_same is_OK_returns_result_E
         get_scdom_component_subset_get_dom_component local.get_dom_component_ok local.get_dom_component_ptr
         node_ptr_kinds_commutes)
   then have "h \<turnstile> get_scdom_component (cast owner_document) \<rightarrow>\<^sub>r child_sc"
     using child_sc
     by (metis (no_types, lifting) \<open>node_ptr |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3)
         get_scdom_component_owner_document_same get_scdom_component_ptrs_same_scope_component
         get_scdom_component_subset_get_dom_component is_OK_returns_result_E local.get_dom_component_ok
         local.get_dom_component_ptr node_ptr_kinds_commutes select_result_I2 subset_code(1))
 
   have "ptr \<notin> set |h \<turnstile> get_dom_component (cast document_ptr)|\<^sub>r"
     by (metis (no_types, lifting) \<open>document_ptr |\<in>| document_ptr_kinds h\<close> assms(1) assms(2) assms(3)
         assms(5) contra_subsetD document_ptr_kinds_commutes get_scdom_component_subset_get_dom_component
         local.get_dom_component_ok returns_result_select_result sc select_result_I2)
 
   moreover have "ptr \<notin> set |h \<turnstile> get_dom_component (cast node_ptr)|\<^sub>r"
     by (metis (no_types, lifting) \<open>node_ptr |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) assms(6)
         child_sc contra_subsetD get_scdom_component_subset_get_dom_component local.get_dom_component_ok
         node_ptr_kinds_commutes returns_result_select_result select_result_I2)
 
   moreover have "ptr \<notin> set |h \<turnstile> get_scdom_component (cast |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 node_ptr)|\<^sub>r)|\<^sub>r"
     using get_scdom_component_owner_document_same get_scdom_component_ptrs_same_scope_component
     by (metis (no_types, lifting)
         \<open>h \<turnstile> get_scdom_component (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) \<rightarrow>\<^sub>r child_sc\<close> assms(6) child_sc
         owner_document select_result_I2)
   have "ptr \<notin> set |h \<turnstile> get_dom_component (cast |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 node_ptr)|\<^sub>r)|\<^sub>r"
     using get_scdom_component_owner_document_same
     by (metis (no_types, opaque_lifting)
         \<open>\<And>thesis. (\<And>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 node_ptr) \<rightarrow>\<^sub>r owner_document \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
         \<open>h \<turnstile> get_scdom_component (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) \<rightarrow>\<^sub>r child_sc\<close>
         \<open>ptr \<notin> set |h \<turnstile> get_scdom_component (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 |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 node_ptr)|\<^sub>r)|\<^sub>r\<close>
         assms(1) assms(2) assms(3) contra_subsetD document_ptr_kinds_commutes get_scdom_component_subset_get_dom_component
         is_OK_returns_result_E local.get_dom_component_ok local.get_owner_document_owner_document_in_heap owner_document
         returns_result_eq select_result_I2)
   ultimately show ?thesis
     using assms(1) assms(2) assms(3) assms(4) adopt_node_is_component_unsafe
     by blast
 qed
 
 lemma adopt_node_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and type_wf: "type_wf h" and known_ptrs: "known_ptrs h"
   assumes "h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {cast document_ptr, cast child} {} h 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(4)
     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 known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "known_ptrs h2"
     using h2 remove_child_preserves_known_ptrs known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
   proof(cases "document_ptr = old_document")
     case True
     then show ?thesis
       using h' wellformed_h2 \<open>type_wf h2\<close> \<open>known_ptrs 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 "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
 
     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 "a_owner_document_valid h"
         using assms(1) heap_is_wellformed_def by(simp add: 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 "a_distinct_lists h2"
         using 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: 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 "a_acyclic_heap h2"
       using wellformed_h2 by (simp add: 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 parent_child_rel_def
         by(simp)
     qed
     then have "a_acyclic_heap h'"
       using \<open>a_acyclic_heap h2\<close> acyclic_heap_def acyclic_subset by blast
 
     moreover have "a_all_ptrs_in_heap h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_all_ptrs_in_heap h3"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1]
        apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1))
       by (metis (no_types, lifting) \<open>child \<in> set disc_nodes_old_document_h2\<close> \<open>type_wf h2\<close>
           disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2
           in_set_remove1 local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2
           returns_result_select_result select_result_I2 wellformed_h2)
     then have "a_all_ptrs_in_heap h'"
       apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1]
        apply (simp add: children_eq2_h3 object_ptr_kinds_h3_eq3 subset_code(1))
       by (metis (no_types, 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
           finite_set_in local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           select_result_I2 set_ConsD subset_code(1) wellformed_h2)
 
     moreover have "a_owner_document_valid h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_owner_document_valid h'"
       apply(simp add: 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 (smt 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) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2
           set_subset_Cons subset_code(1))
 
     have a_distinct_lists_h2: "a_distinct_lists h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def)
     then have "a_distinct_lists h'"
       apply(auto simp add: 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 fmember.rep_eq set_sorted_list_of_set)
                 ultimately show ?thesis
                   using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr = y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3
                   by auto
               next
                 case False
                 then show ?thesis
                   using 5
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr \<noteq> y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close>
                     disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
                   by (metis \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}\<close>
                       empty_iff inf.idem)
               qed
             qed
           qed
         qed
       qed
     next
       fix x xa xb
       assume 0: "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
                                   (sorted_list_of_set (fset (object_ptr_kinds h')))))"
         and 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                    (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
         and 2: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h2). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         and 3: "xa |\<in>| object_ptr_kinds h'"
         and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 5: "xb |\<in>| document_ptr_kinds h'"
         and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       then show False
         using \<open>child \<in> set disc_nodes_old_document_h2\<close> disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2
           document_ptr_kinds_eq2_h3  old_document_in_heap
         apply(auto)[1]
         apply(cases "xb = old_document")
       proof -
         assume a1: "xb = old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a3: "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 child disc_nodes_old_document_h2"
         assume a4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a5: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f6: "old_document |\<in>| document_ptr_kinds h'"
           using a1 \<open>xb |\<in>| document_ptr_kinds h'\<close> by blast
         have f7: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a2 by simp
         have "x \<in> set disc_nodes_old_document_h2"
           using f6 a3 a1 by (metis (no_types) \<open>type_wf h'\<close> \<open>x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r\<close>
               disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq
               returns_result_select_result set_remove1_subset subsetCE)
         then have "set |h' \<turnstile> get_child_nodes xa|\<^sub>r \<inter>  set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
           using f7 f6 a5 a4 \<open>xa |\<in>| object_ptr_kinds h'\<close>
           by fastforce
         then show ?thesis
           using \<open>x \<in> set disc_nodes_old_document_h2\<close> a1 a4 f7 by blast
       next
         assume a1: "xb \<noteq> old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3"
         assume a3: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a4: "xa |\<in>| object_ptr_kinds h'"
         assume a5: "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r child # disc_nodes_document_ptr_h3"
         assume a6: "old_document |\<in>| document_ptr_kinds h'"
         assume a7: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
         assume a8: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a10: "\<And>doc_ptr. old_document \<noteq> doc_ptr
                \<Longrightarrow> |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a11: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr
                \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a12: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                     \<inter> (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f13: "\<And>d. d \<notin> set |h' \<turnstile> document_ptr_kinds_M|\<^sub>r \<or> h2 \<turnstile> ok get_disconnected_nodes d"
           using a9 \<open>type_wf h2\<close> get_disconnected_nodes_ok
           by simp
         then have f14: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a6 a3 by simp
         have "x \<notin> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
           using a12 a8 a4 \<open>xb |\<in>| document_ptr_kinds h'\<close>
           by (meson UN_I disjoint_iff_not_equal fmember.rep_eq)
         then have "x = child"
           using f13 a11 a10 a7 a5 a2 a1
           by (metis (no_types, lifting) select_result_I2 set_ConsD)
         then have "child \<notin> set disc_nodes_old_document_h2"
           using f14 a12 a8 a6 a4
           by (metis \<open>type_wf h'\<close> adopt_node_removes_child assms 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 show ?thesis
       using \<open>type_wf h'\<close> \<open>known_ptrs h'\<close> \<open>a_owner_document_valid h'\<close> heap_is_wellformed_def by blast
   qed
   then have "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
     by auto
 
   have object_ptr_kinds_eq3: "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 adopt_node_writes assms(4)])
     unfolding adopt_node_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       remove_child_pointers_preserved
     by (auto simp add: reflp_def transp_def split: if_splits)
   show ?thesis
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def object_ptr_kinds_eq3 )[1]
     using adopt_node_is_strongly_dom_component_safe_step get_scdom_component_impl assms by blast
 qed
 end
 
 interpretation i_get_scdom_component_adopt_node?: l_get_scdom_component_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe 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 get_child_nodes get_child_nodes_locs
   set_child_nodes set_child_nodes_locs remove to_tree_order get_root_node get_root_node_locs
   get_ancestors get_ancestors_locs get_element_by_id get_elements_by_class_name get_elements_by_tag_name
   by(auto simp add: l_get_scdom_component_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 
 subsubsection \<open>create\_element\<close>
 
 locale l_get_scdom_component_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_dom_component_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_to_tree_order\<^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
 begin
 
 lemma create_element_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast document_ptr)|\<^sub>r"
   assumes "ptr \<noteq> cast |h \<turnstile> create_element document_ptr tag|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   obtain new_element_ptr h2 h3 disc_nodes 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 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes" and
     h': "h3 \<turnstile> set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes) \<rightarrow>\<^sub>h h'"
     using assms(4)
     by(auto simp add: create_element_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated,
           OF get_disconnected_nodes_pure, rotated])
 
   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)
 
   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 "heap_is_wellformed h'"
     using assms(4)
     using assms(1) assms(2) assms(3) local.create_element_preserves_wellformedness(1) by blast
   have "type_wf h'"
     using assms(1) assms(2) assms(3) assms(4) local.create_element_preserves_wellformedness(2) by blast
   have "known_ptrs h'"
     using assms(1) assms(2) assms(3) assms(4) local.create_element_preserves_wellformedness(3) by blast
 
   have "document_ptr |\<in>| document_ptr_kinds h"
     by (meson assms(4) is_OK_returns_heap_I local.create_element_document_in_heap)
   then
   obtain sc where sc: "h \<turnstile> get_scdom_component (cast document_ptr) \<rightarrow>\<^sub>r sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) document_ptr_kinds_commutes returns_result_select_result)
 
   have "document_ptr |\<in>| document_ptr_kinds h'"
     using \<open>document_ptr |\<in>| document_ptr_kinds h\<close> document_ptr_kinds_eq_h
     using document_ptr_kinds_eq_h2 document_ptr_kinds_eq_h3 by blast
   then
   obtain sc' where sc': "h' \<turnstile> get_scdom_component (cast document_ptr) \<rightarrow>\<^sub>r sc'"
     using get_scdom_component_ok
     by (meson \<open>heap_is_wellformed h'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> document_ptr_kinds_commutes
         returns_result_select_result)
 
   obtain c where c: "h \<turnstile> get_dom_component (cast document_ptr) \<rightarrow>\<^sub>r c"
     by (meson \<open>document_ptr |\<in>| document_ptr_kinds h\<close> assms(1) assms(2) assms(3)
         document_ptr_kinds_commutes is_OK_returns_result_E local.get_dom_component_ok)
 
   have "set c \<subseteq> set sc"
     using assms(1) assms(2) assms(3) c get_scdom_component_subset_get_dom_component sc by blast
 
   have "ptr \<notin> set c"
     using \<open>set c \<subseteq> set sc\<close> assms(5) sc
     by auto
   then
   show ?thesis
     using create_element_is_weakly_dom_component_safe
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) assms(6) c
         local.create_element_is_weakly_dom_component_safe_step select_result_I2)
 qed
 
 lemma create_element_is_strongly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>r result"
   assumes "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {cast document_ptr} {cast result} h 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(5)
     by(auto simp add: create_element_def returns_result_heap_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF 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 local.get_disconnected_nodes_pure pure_returns_heap_eq)
     by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
   then have "result = new_element_ptr"
     using assms(4) by auto
 
 
   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)
 
   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_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
   have "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
       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' 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 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 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_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 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 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 "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 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 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(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 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 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 "parent_child_rel h = parent_child_rel h'"
   proof -
     have "parent_child_rel h = parent_child_rel h2"
     proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
     also have "\<dots> = parent_child_rel h'"
       by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
     finally show ?thesis
       by simp
   qed
 
 
   have "document_ptr |\<in>| document_ptr_kinds h'"
     by (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close> document_ptr_kinds_eq_h
         document_ptr_kinds_eq_h2 document_ptr_kinds_eq_h3)
 
   have "known_ptr (cast document_ptr)"
     using \<open>document_ptr |\<in>| document_ptr_kinds h\<close> assms(3) document_ptr_kinds_commutes
       local.known_ptrs_known_ptr by blast
   have "h \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr"
     using \<open>known_ptr (cast document_ptr)\<close> \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, rule conjI)+
     by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
         ElementClass.known_ptr_defs NodeClass.known_ptr_defs 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_returns_result_I split: option.splits)
   have "h' \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr"
     using \<open>known_ptr (cast document_ptr)\<close> \<open>document_ptr |\<in>| document_ptr_kinds h'\<close>
     apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, rule conjI)+
     by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
         ElementClass.known_ptr_defs NodeClass.known_ptr_defs 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_returns_result_I split: option.splits)
 
   obtain to where to: "h \<turnstile> to_tree_order (cast document_ptr) \<rightarrow>\<^sub>r to"
     by (meson \<open>h \<turnstile> get_owner_document (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) \<rightarrow>\<^sub>r document_ptr\<close> assms(1)
         assms(2) assms(3) is_OK_returns_result_E is_OK_returns_result_I local.get_owner_document_ptr_in_heap
         local.to_tree_order_ok)
   obtain to' where to': "h' \<turnstile> to_tree_order (cast document_ptr) \<rightarrow>\<^sub>r to'"
     by (metis \<open>document_ptr |\<in>| document_ptr_kinds h\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> assms(1) assms(2)
         assms(3) assms(5) document_ptr_kinds_commutes document_ptr_kinds_eq_h document_ptr_kinds_eq_h2
         document_ptr_kinds_eq_h3 is_OK_returns_result_E local.create_element_preserves_wellformedness(1)
         local.to_tree_order_ok)
   have "set to = set to'"
   proof safe
     fix x
     assume "x \<in> set to"
     show "x \<in> set to'"
       using to to'
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to\<close> assms(1) assms(2) assms(3) assms(5)
           local.create_element_preserves_wellformedness(1))
   next
     fix x
     assume "x \<in> set to'"
     show "x \<in> set to"
       using to to'
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to'\<close> assms(1) assms(2) assms(3) assms(5)
           local.create_element_preserves_wellformedness(1))
   qed
 
   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
   obtain disc_nodes_h' where disc_nodes_h': "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h'"
     and "cast new_element_ptr \<in> set disc_nodes_h'"
     and "disc_nodes_h' =  cast new_element_ptr # disc_nodes_h3"
     by (simp add: \<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>)
 
   have "\<And>disc_ptr to to'. disc_ptr \<in> set disc_nodes_h3 \<Longrightarrow> h \<turnstile> to_tree_order (cast disc_ptr) \<rightarrow>\<^sub>r to \<Longrightarrow>
 h' \<turnstile> to_tree_order (cast disc_ptr) \<rightarrow>\<^sub>r to' \<Longrightarrow> set to = set to'"
   proof safe
     fix disc_ptr to to' x
     assume "disc_ptr \<in> set disc_nodes_h3"
     assume "h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to"
     assume "h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'"
     assume "x \<in> set to"
     show "x \<in> set to'"
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to\<close>
           \<open>h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to\<close>
           assms(1) assms(2) assms(3) assms(5) local.create_element_preserves_wellformedness(1))
   next
     fix disc_ptr to to' x
     assume "disc_ptr \<in> set disc_nodes_h3"
     assume "h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to"
     assume "h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'"
     assume "x \<in> set to'"
     show "x \<in> set to"
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to\<close>
           \<open>h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to'\<close>
           assms(1) assms(2) assms(3) assms(5) local.create_element_preserves_wellformedness(1))
   qed
 
   have "heap_is_wellformed h'"
     using assms(1) assms(2) assms(3) assms(5) local.create_element_preserves_wellformedness(1)
     by blast
 
   have "cast new_element_ptr |\<in>| object_ptr_kinds h'"
     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 \<in> set disc_nodes_h'\<close> \<open>heap_is_wellformed h'\<close> disc_nodes_h'
       local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_commutes by blast
   then
   have "new_element_ptr |\<in>| element_ptr_kinds h'"
     by simp
 
   have "\<And>node_ptr. node_ptr \<in> set disc_nodes_h3 \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h'"
     by (meson \<open>heap_is_wellformed h'\<close> h' local.heap_is_wellformed_disc_nodes_in_heap
         local.set_disconnected_nodes_get_disconnected_nodes set_subset_Cons subset_code(1))
 
   have "h \<turnstile> ok (map_M (to_tree_order \<circ> 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) disc_nodes_h3)"
     using assms(1) assms(2) assms(3) to_tree_order_ok
     apply(auto intro!: map_M_ok_I)[1]
     using disc_nodes_document_ptr_h local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_commutes
     by blast
   then
   obtain disc_tree_orders where disc_tree_orders:
     "h \<turnstile> map_M (to_tree_order \<circ> 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) disc_nodes_h3 \<rightarrow>\<^sub>r disc_tree_orders"
     by auto
 
   have "h' \<turnstile> ok (map_M (to_tree_order \<circ> 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) disc_nodes_h')"
     apply(auto intro!: map_M_ok_I)[1]
     apply(simp add: \<open>disc_nodes_h' =  cast new_element_ptr # disc_nodes_h3\<close>)
     using \<open>\<And>node_ptr. node_ptr \<in> set disc_nodes_h3 \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds 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 \<in> set disc_nodes_h'\<close> \<open>heap_is_wellformed h'\<close> \<open>known_ptrs h'\<close>
       \<open>type_wf h'\<close> disc_nodes_h' local.heap_is_wellformed_disc_nodes_in_heap local.to_tree_order_ok
       node_ptr_kinds_commutes by blast
   then
   obtain disc_tree_orders' where disc_tree_orders':
     "h' \<turnstile> map_M (to_tree_order \<circ> 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) disc_nodes_h' \<rightarrow>\<^sub>r disc_tree_orders'"
     by auto
 
   have "h' \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []"
     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> children_eq_h2
       children_eq_h3 by auto
 
   obtain new_tree_order where new_tree_order:
     "h' \<turnstile> to_tree_order (cast new_element_ptr) \<rightarrow>\<^sub>r new_tree_order" and
     "new_tree_order \<in> set disc_tree_orders'"
     using map_M_pure_E[OF disc_tree_orders' \<open>cast new_element_ptr \<in> set disc_nodes_h'\<close>]
     by auto
   then have "new_tree_order = [cast new_element_ptr]"
     using \<open>h' \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []\<close>
     by(auto simp add: to_tree_order_def
         dest!: bind_returns_result_E3[rotated, OF \<open>h' \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []\<close>, rotated])
 
   obtain foo where foo: "h' \<turnstile> map_M (to_tree_order \<circ> 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)
 (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) \<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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr] # foo"
     apply(auto intro!: bind_pure_returns_result_I map_M_pure_I)[1]
     using \<open>new_tree_order = [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> new_tree_order apply auto[1]
     by (smt \<open>disc_nodes_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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr # disc_nodes_h3\<close>
         bind_pure_returns_result_I bind_returns_result_E2 comp_apply disc_tree_orders'
         local.to_tree_order_pure map_M.simps(2) map_M_pure_I return_returns_result returns_result_eq)
   then have "set (concat foo) = set (concat disc_tree_orders)"
     apply(auto elim!: bind_returns_result_E2 intro!: map_M_pure_I)[1]
      apply (smt \<open>\<And>to' toa disc_ptr. \<lbrakk>disc_ptr \<in> set disc_nodes_h3;
 h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r toa; h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<rbrakk>
 \<Longrightarrow> set toa = set to'\<close> comp_apply disc_tree_orders local.to_tree_order_pure map_M_pure_E map_M_pure_E2)
     using \<open>\<And>to' toa disc_ptr. \<lbrakk>disc_ptr \<in> set disc_nodes_h3; h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r toa;
 h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<rbrakk> \<Longrightarrow> set toa = set to'\<close> comp_apply
       disc_tree_orders local.to_tree_order_pure map_M_pure_E map_M_pure_E2
     by smt
 
   have "disc_tree_orders' = [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] # foo"
     using foo disc_tree_orders'
     by (simp add: \<open>disc_nodes_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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr # disc_nodes_h3\<close> returns_result_eq)
 
   have "set (concat disc_tree_orders') = {cast new_element_ptr} \<union> set (concat disc_tree_orders)"
     apply(auto simp add: \<open>disc_tree_orders' = [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] # foo\<close>)[1]
     using \<open>set (concat foo) = set (concat disc_tree_orders)\<close> by auto
 
   have "h' \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to' @ concat disc_tree_orders'"
     using \<open>h' \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr\<close> disc_nodes_h' to' disc_tree_orders'
     by(auto simp add: a_get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   then
   have "set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to' \<union> set (concat disc_tree_orders')"
     by auto
   have "h \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to @ concat disc_tree_orders"
     using \<open>h \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr\<close> disc_nodes_document_ptr_h
       to disc_tree_orders
     by(auto simp add: a_get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   then
   have "set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r = set to \<union> set (concat disc_tree_orders)"
     by auto
 
   have "{cast new_element_ptr} \<union> set |h \<turnstile> local.a_get_scdom_component (cast document_ptr)|\<^sub>r =
 set |h' \<turnstile> local.a_get_scdom_component (cast document_ptr)|\<^sub>r"
   proof(safe)
     show "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
          \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
       using \<open>h' \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to' @ concat disc_tree_orders'\<close>
       apply(auto simp add: a_get_scdom_component_def)[1]
       by (meson \<open>\<And>thesis. (\<And>new_tree_order. \<lbrakk>h' \<turnstile> to_tree_order (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 new_tree_order;
 new_tree_order \<in> set disc_tree_orders'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> local.to_tree_order_ptr_in_result)
   next
     fix x
     assume " x \<in> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     then
     show "x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
       using \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union>set (concat disc_tree_orders)\<close>
       using \<open>set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to' \<union> set (concat disc_tree_orders')\<close>
       using \<open>set to = set to'\<close>
       using \<open>set (concat disc_tree_orders') = {cast new_element_ptr} \<union> set (concat disc_tree_orders)\<close>
       by(auto)
   next
     fix x
     assume " x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     assume "x \<notin> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     show "x = 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"
       using \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close>
       using \<open>set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to' \<union> set (concat disc_tree_orders')\<close>
       using \<open>set to = set to'\<close>
       using \<open>set (concat disc_tree_orders') = {cast new_element_ptr} \<union> set (concat disc_tree_orders)\<close>
       using \<open>x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
         \<open>x \<notin> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
       by auto
   qed
 
 
   have "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_element_ptr|}"
     using object_ptr_kinds_eq_h object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 by auto
   then
   show ?thesis
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def)[1]
        apply(rule bexI[where x="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"])
     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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr} \<union>
 set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
         apply auto[2]
     using \<open>set to = set to'\<close> \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close> local.to_tree_order_ptr_in_result to'
         apply auto[1]
     using \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
        apply blast
       apply(rule bexI[where x="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"])
     using \<open>result = new_element_ptr\<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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr} \<union> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close> apply auto[1]
       apply(auto)[1]
     using \<open>set to = set to'\<close> \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close> local.to_tree_order_ptr_in_result to' apply auto[1]
       apply (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close>)
     using \<open>\<And>thesis. (\<And>new_element_ptr h2 h3 disc_nodes_h3. \<lbrakk>h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr;
 h \<turnstile> new_element \<rightarrow>\<^sub>h h2; h2 \<turnstile> set_tag_name new_element_ptr tag \<rightarrow>\<^sub>h h3;
 h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3;
 h3 \<turnstile> set_disconnected_nodes 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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr # disc_nodes_h3) \<rightarrow>\<^sub>h h'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
       new_element_ptr new_element_ptr_not_in_heap
      apply auto[1]
     using create_element_is_strongly_scdom_component_safe_step
     by (smt 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>
         \<open>result = new_element_ptr\<close> assms(1) assms(2) assms(3) assms(4) assms(5) local.get_scdom_component_impl select_result_I2)
 qed
 end
 
 interpretation i_get_scdom_component_remove_child?: l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs get_scdom_component
   is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component is_strongly_dom_component_safe
   is_weakly_dom_component_safe to_tree_order get_parent get_parent_locs get_child_nodes get_child_nodes_locs
   get_root_node get_root_node_locs get_ancestors get_ancestors_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_element_by_id get_elements_by_class_name get_elements_by_tag_name set_child_nodes set_child_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs remove_child remove_child_locs remove
   by(auto simp add: l_get_scdom_component_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_remove_child\<^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_get_scdom_component_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_dom_component_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_to_tree_order\<^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
 begin
 
 lemma create_character_data_is_strongly_dom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast document_ptr)|\<^sub>r"
   assumes "ptr \<noteq> cast |h \<turnstile> create_character_data document_ptr text|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   have "document_ptr |\<in>| document_ptr_kinds h"
     by (meson assms(4) is_OK_returns_heap_I local.create_character_data_document_in_heap)
   then
   obtain sc where sc: "h \<turnstile> get_scdom_component (cast document_ptr) \<rightarrow>\<^sub>r sc"
     using get_scdom_component_ok
     by (meson assms(1) assms(2) assms(3) document_ptr_kinds_commutes returns_result_select_result)
 
   obtain c where c: "h \<turnstile> get_dom_component (cast document_ptr) \<rightarrow>\<^sub>r c"
     by (meson \<open>document_ptr |\<in>| document_ptr_kinds h\<close> assms(1) assms(2) assms(3)
         document_ptr_kinds_commutes is_OK_returns_result_E local.get_dom_component_ok)
 
   have "set c \<subseteq> set sc"
     using assms(1) assms(2) assms(3) c get_scdom_component_subset_get_dom_component sc by blast
 
   have "ptr \<notin> set c"
     using \<open>set c \<subseteq> set sc\<close> assms(5) sc
     by auto
   then
   show ?thesis
     by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) assms(6) c
         local.create_character_data_is_weakly_dom_component_safe_step select_result_I2)
 qed
 
 lemma create_character_data_is_strongly_dom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>r result"
   assumes "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {cast document_ptr} {cast result} h 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(5)
     by(auto simp add: create_character_data_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF 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: 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.get_disconnected_nodes_pure
         pure_returns_heap_eq)
     by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
   then have "result = new_character_data_ptr"
     using assms(4) by auto
 
   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 set_val_writes h3])
     using 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 "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       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' 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 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 set_val_writes h3])
     using 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 "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       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' 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 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 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 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_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 get_disconnected_nodes_reads 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 "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 set_val_writes h3]
     using  set_val_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 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(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 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 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 "parent_child_rel h = parent_child_rel h'"
   proof -
     have "parent_child_rel h = parent_child_rel h2"
     proof(auto simp add: 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: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
     also have "\<dots> = parent_child_rel h'"
       by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
     finally show ?thesis
       by simp
   qed
 
   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>
       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
   have "known_ptrs h'"
     using known_ptrs_preserved object_ptr_kinds_eq_h3 by blast
 
 
 
 
   have "document_ptr |\<in>| document_ptr_kinds h'"
     by (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close> document_ptr_kinds_eq_h
         document_ptr_kinds_eq_h2 document_ptr_kinds_eq_h3)
 
   have "known_ptr (cast document_ptr)"
     using \<open>document_ptr |\<in>| document_ptr_kinds h\<close> assms(3) document_ptr_kinds_commutes
       local.known_ptrs_known_ptr by blast
   have "h \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr"
     using \<open>known_ptr (cast document_ptr)\<close> \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, rule conjI)+
     by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
         ElementClass.known_ptr_defs NodeClass.known_ptr_defs 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_returns_result_I split: option.splits)
   have "h' \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr"
     using \<open>known_ptr (cast document_ptr)\<close> \<open>document_ptr |\<in>| document_ptr_kinds h'\<close>
     apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, rule conjI)+
     by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs
         ElementClass.known_ptr_defs NodeClass.known_ptr_defs 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_returns_result_I split: option.splits)
 
   obtain to where to: "h \<turnstile> to_tree_order (cast document_ptr) \<rightarrow>\<^sub>r to"
     by (meson \<open>h \<turnstile> get_owner_document (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) \<rightarrow>\<^sub>r document_ptr\<close>
         assms(1) assms(2) assms(3) is_OK_returns_result_E is_OK_returns_result_I
         local.get_owner_document_ptr_in_heap local.to_tree_order_ok)
   obtain to' where to': "h' \<turnstile> to_tree_order (cast document_ptr) \<rightarrow>\<^sub>r to'"
     by (metis \<open>document_ptr |\<in>| document_ptr_kinds h\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> assms(1) assms(2)
         assms(3) assms(5) document_ptr_kinds_commutes document_ptr_kinds_eq_h document_ptr_kinds_eq_h2
         document_ptr_kinds_eq_h3 is_OK_returns_result_E local.create_character_data_preserves_wellformedness(1)
         local.to_tree_order_ok)
   have "set to = set to'"
   proof safe
     fix x
     assume "x \<in> set to"
     show "x \<in> set to'"
       using to to'
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to\<close> assms(1) assms(2) assms(3) assms(5)
           local.create_character_data_preserves_wellformedness(1))
   next
     fix x
     assume "x \<in> set to'"
     show "x \<in> set to"
       using to to'
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to'\<close> assms(1) assms(2) assms(3) assms(5)
           local.create_character_data_preserves_wellformedness(1))
   qed
 
   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
   obtain disc_nodes_h' where disc_nodes_h': "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h'"
     and "cast new_character_data_ptr \<in> set disc_nodes_h'"
     and "disc_nodes_h' =  cast new_character_data_ptr # disc_nodes_h3"
     by (simp add: \<open>h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r cast new_character_data_ptr # disc_nodes_h3\<close>)
 
   have "\<And>disc_ptr to to'. disc_ptr \<in> set disc_nodes_h3 \<Longrightarrow> h \<turnstile> to_tree_order (cast disc_ptr) \<rightarrow>\<^sub>r to \<Longrightarrow>
 h' \<turnstile> to_tree_order (cast disc_ptr) \<rightarrow>\<^sub>r to' \<Longrightarrow> set to = set to'"
   proof safe
     fix disc_ptr to to' x
     assume "disc_ptr \<in> set disc_nodes_h3"
     assume "h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to"
     assume "h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'"
     assume "x \<in> set to"
     show "x \<in> set to'"
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to\<close>
           \<open>h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to\<close>
           assms(1) assms(2) assms(3) assms(5) local.create_character_data_preserves_wellformedness(1))
   next
     fix disc_ptr to to' x
     assume "disc_ptr \<in> set disc_nodes_h3"
     assume "h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to"
     assume "h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'"
     assume "x \<in> set to'"
     show "x \<in> set to"
       using to_tree_order_parent_child_rel \<open>parent_child_rel h = parent_child_rel h'\<close>
       by (metis \<open>h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to\<close>
           \<open>h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close> \<open>x \<in> set to'\<close>
           assms(1) assms(2) assms(3) assms(5) local.create_character_data_preserves_wellformedness(1))
   qed
 
   have "heap_is_wellformed h'"
     using assms(1) assms(2) assms(3) assms(5) local.create_character_data_preserves_wellformedness(1)
     by blast
 
   have "cast new_character_data_ptr |\<in>| object_ptr_kinds h'"
     using \<open>cast new_character_data_ptr \<in> set disc_nodes_h'\<close> \<open>heap_is_wellformed h'\<close> disc_nodes_h'
       local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_commutes by blast
   then
   have "new_character_data_ptr |\<in>| character_data_ptr_kinds h'"
     by simp
 
   have "\<And>node_ptr. node_ptr \<in> set disc_nodes_h3 \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h'"
     by (meson \<open>heap_is_wellformed h'\<close> h' local.heap_is_wellformed_disc_nodes_in_heap
         local.set_disconnected_nodes_get_disconnected_nodes set_subset_Cons subset_code(1))
 
   have "h \<turnstile> ok (map_M (to_tree_order \<circ> 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) disc_nodes_h3)"
     using assms(1) assms(2) assms(3) to_tree_order_ok
     apply(auto intro!: map_M_ok_I)[1]
     using disc_nodes_document_ptr_h local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_commutes
     by blast
   then
   obtain disc_tree_orders where disc_tree_orders:
     "h \<turnstile> map_M (to_tree_order \<circ> 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) disc_nodes_h3 \<rightarrow>\<^sub>r disc_tree_orders"
     by auto
 
   have "h' \<turnstile> ok (map_M (to_tree_order \<circ> 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) disc_nodes_h')"
     apply(auto intro!: map_M_ok_I)[1]
     apply(simp add: \<open>disc_nodes_h' =  cast new_character_data_ptr # disc_nodes_h3\<close>)
     using \<open>\<And>node_ptr. node_ptr \<in> set disc_nodes_h3 \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h'\<close>
       \<open>cast new_character_data_ptr \<in> set disc_nodes_h'\<close> \<open>heap_is_wellformed h'\<close> \<open>known_ptrs h'\<close>
       \<open>type_wf h'\<close> disc_nodes_h' local.heap_is_wellformed_disc_nodes_in_heap local.to_tree_order_ok
       node_ptr_kinds_commutes by blast
   then
   obtain disc_tree_orders' where disc_tree_orders':
     "h' \<turnstile> map_M (to_tree_order \<circ> 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) disc_nodes_h' \<rightarrow>\<^sub>r disc_tree_orders'"
     by auto
 
   have "h' \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close> children_eq_h2 children_eq_h3 by auto
 
   obtain new_tree_order where new_tree_order:
     "h' \<turnstile> to_tree_order (cast new_character_data_ptr) \<rightarrow>\<^sub>r new_tree_order" and
     "new_tree_order \<in> set disc_tree_orders'"
     using map_M_pure_E[OF disc_tree_orders' \<open>cast new_character_data_ptr \<in> set disc_nodes_h'\<close>]
     by auto
   then have "new_tree_order = [cast new_character_data_ptr]"
     using \<open>h' \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
     by(auto simp add: to_tree_order_def
         dest!: bind_returns_result_E3[rotated, OF \<open>h' \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>, rotated])
 
   obtain foo where foo: "h' \<turnstile> map_M (to_tree_order \<circ> 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)
 (cast new_character_data_ptr # disc_nodes_h3) \<rightarrow>\<^sub>r [cast new_character_data_ptr] # foo"
     apply(auto intro!: bind_pure_returns_result_I map_M_pure_I)[1]
     using \<open>new_tree_order = [cast new_character_data_ptr]\<close> new_tree_order apply auto[1]
     using \<open>disc_nodes_h' = cast new_character_data_ptr # disc_nodes_h3\<close> bind_pure_returns_result_I
       bind_returns_result_E2 comp_apply disc_tree_orders' local.to_tree_order_pure map_M.simps(2)
       map_M_pure_I return_returns_result returns_result_eq
     apply simp
     by (smt \<open>disc_nodes_h' = cast new_character_data_ptr # disc_nodes_h3\<close> bind_pure_returns_result_I
         bind_returns_result_E2 comp_apply disc_tree_orders' local.to_tree_order_pure map_M.simps(2) map_M_pure_I
         return_returns_result returns_result_eq)
   then have "set (concat foo) = set (concat disc_tree_orders)"
     apply(auto elim!: bind_returns_result_E2 intro!: map_M_pure_I)[1]
      apply (smt \<open>\<And>to' toa disc_ptr. \<lbrakk>disc_ptr \<in> set disc_nodes_h3;
 h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r toa; h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<rbrakk> \<Longrightarrow>
 set toa = set to'\<close> comp_apply disc_tree_orders local.to_tree_order_pure map_M_pure_E map_M_pure_E2)
     using \<open>\<And>to' toa disc_ptr. \<lbrakk>disc_ptr \<in> set disc_nodes_h3; h \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r toa;
 h' \<turnstile> to_tree_order (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 disc_ptr) \<rightarrow>\<^sub>r to'\<rbrakk> \<Longrightarrow> set toa = set to'\<close> comp_apply disc_tree_orders
       local.to_tree_order_pure map_M_pure_E map_M_pure_E2
     by smt
 
   have "disc_tree_orders' = [cast new_character_data_ptr] # foo"
     using foo disc_tree_orders'
     by (simp add: \<open>disc_nodes_h' = cast new_character_data_ptr # disc_nodes_h3\<close> returns_result_eq)
 
   have "set (concat disc_tree_orders') = {cast new_character_data_ptr} \<union> set (concat disc_tree_orders)"
     apply(auto simp add: \<open>disc_tree_orders' = [cast new_character_data_ptr] # foo\<close>)[1]
     using \<open>set (concat foo) = set (concat disc_tree_orders)\<close> by auto
 
   have "h' \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to' @ concat disc_tree_orders'"
     using \<open>h' \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr\<close> disc_nodes_h' to' disc_tree_orders'
     by(auto simp add: a_get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   then
   have "set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r = set to' \<union> set (concat disc_tree_orders')"
     by auto
   have "h \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to @ concat disc_tree_orders"
     using \<open>h \<turnstile> get_owner_document (cast document_ptr) \<rightarrow>\<^sub>r document_ptr\<close> disc_nodes_document_ptr_h to disc_tree_orders
     by(auto simp add: a_get_scdom_component_def intro!: bind_pure_returns_result_I map_M_pure_I)
   then
   have "set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r = set to \<union> set (concat disc_tree_orders)"
     by auto
 
   have "{cast new_character_data_ptr} \<union> set |h \<turnstile> local.a_get_scdom_component (cast document_ptr)|\<^sub>r =
 set |h' \<turnstile> local.a_get_scdom_component (cast document_ptr)|\<^sub>r"
   proof(safe)
     show "cast new_character_data_ptr
          \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
       using \<open>h' \<turnstile> local.a_get_scdom_component (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) \<rightarrow>\<^sub>r to' @ concat disc_tree_orders'\<close>
       apply(auto simp add: a_get_scdom_component_def)[1]
       by (meson \<open>\<And>thesis. (\<And>new_tree_order. \<lbrakk>h' \<turnstile> to_tree_order (cast new_character_data_ptr) \<rightarrow>\<^sub>r new_tree_order;
 new_tree_order \<in> set disc_tree_orders'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> local.to_tree_order_ptr_in_result)
   next
     fix x
     assume " x \<in> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     then
     show "x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
       using \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close>
       using \<open>set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to' \<union> set (concat disc_tree_orders')\<close>
       using \<open>set to = set to'\<close>
       using \<open>set (concat disc_tree_orders') = {cast new_character_data_ptr} \<union> set (concat disc_tree_orders)\<close>
       by(auto)
   next
     fix x
     assume " x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     assume "x \<notin> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r"
     show "x = cast new_character_data_ptr"
       using \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close>
       using \<open>set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to' \<union> set (concat disc_tree_orders')\<close>
       using \<open>set to = set to'\<close>
       using \<open>set (concat disc_tree_orders') = {cast new_character_data_ptr} \<union> set (concat disc_tree_orders)\<close>
       using \<open>x \<in> set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
         \<open>x \<notin> set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
       by auto
   qed
 
 
   have "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
     using object_ptr_kinds_eq_h object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 by auto
   then
   show ?thesis
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def)[1]
        apply(rule bexI[where x="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"])
     using \<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} \<union> set |h \<turnstile> local.a_get_scdom_component
 (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)|\<^sub>r = set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
         apply auto[2]
     using \<open>set to = set to'\<close> \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close> local.to_tree_order_ptr_in_result to'
         apply auto[1]
     using \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
        apply blast
       apply(rule bexI[where x="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"])
     using \<open>result = new_character_data_ptr\<close> \<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} \<union>
 set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set |h' \<turnstile> local.a_get_scdom_component (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)|\<^sub>r\<close>
        apply auto[1]
       apply(auto)[1]
     using \<open>set to = set to'\<close> \<open>set |h \<turnstile> local.a_get_scdom_component (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)|\<^sub>r =
 set to \<union> set (concat disc_tree_orders)\<close> local.to_tree_order_ptr_in_result to' apply auto[1]
       apply (simp add: \<open>document_ptr |\<in>| document_ptr_kinds h\<close>)
     using \<open>\<And>thesis. (\<And>new_character_data_ptr h2 h3 disc_nodes_h3. \<lbrakk>h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr;
 h \<turnstile> new_character_data \<rightarrow>\<^sub>h h2; h2 \<turnstile> set_val new_character_data_ptr text \<rightarrow>\<^sub>h h3;
 h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3;
 h3 \<turnstile> set_disconnected_nodes document_ptr (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 # disc_nodes_h3) \<rightarrow>\<^sub>h h'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
       new_character_data_ptr new_character_data_ptr_not_in_heap
      apply auto[1]
     using create_character_data_is_strongly_dom_component_safe_step
     by (smt ObjectMonad.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>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>
         \<open>result = new_character_data_ptr\<close> assms(1) assms(2) assms(3) assms(4) assms(5) local.get_scdom_component_impl select_result_I2)
 qed
 end
 
 interpretation i_get_scdom_component_create_character_data?: l_get_scdom_component_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs get_scdom_component
   is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component is_strongly_dom_component_safe
   is_weakly_dom_component_safe to_tree_order get_parent get_parent_locs get_child_nodes get_child_nodes_locs
   get_root_node get_root_node_locs get_ancestors get_ancestors_locs get_element_by_id get_elements_by_class_name
   get_elements_by_tag_name set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs create_character_data
   by(auto simp add: l_get_scdom_component_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>create\_document\<close>
 
 lemma create_document_not_strongly_component_safe:
   obtains
     h :: "('object_ptr::{equal,linorder}, 'node_ptr::{equal,linorder}, 'element_ptr::{equal,linorder},
 'character_data_ptr::{equal,linorder}, 'document_ptr::{equal,linorder}, 'shadow_root_ptr::{equal,linorder},
 'Object::{equal,linorder}, 'Node::{equal,linorder}, 'Element::{equal,linorder},
 'CharacterData::{equal,linorder}, 'Document::{equal,linorder}) heap" and
     h' and new_document_ptr where
     "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" and
     "h \<turnstile> create_document \<rightarrow>\<^sub>r new_document_ptr \<rightarrow>\<^sub>h h'" and
     "\<not> is_strongly_scdom_component_safe {} {cast new_document_ptr} h h'"
 proof -
   let ?h0 = "Heap fmempty ::('object_ptr::{equal,linorder}, 'node_ptr::{equal,linorder},
 'element_ptr::{equal,linorder}, 'character_data_ptr::{equal,linorder}, 'document_ptr::{equal,linorder},
 'shadow_root_ptr::{equal,linorder}, 'Object::{equal,linorder}, 'Node::{equal,linorder},
 'Element::{equal,linorder}, 'CharacterData::{equal,linorder}, 'Document::{equal,linorder}) heap"
   let ?P = "create_document"
   let ?h1 = "|?h0 \<turnstile> ?P|\<^sub>h"
   let ?document_ptr = "|?h0 \<turnstile> ?P|\<^sub>r"
 
   show thesis
     apply(rule that[where h="?h1"])
     by code_simp+
 qed
 
 locale l_get_scdom_component_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component_get_scdom_component +
   l_get_dom_component_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma create_document_is_weakly_scdom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> create_document \<rightarrow>\<^sub>r result"
   assumes "h \<turnstile> create_document \<rightarrow>\<^sub>h h'"
   shows "is_weakly_scdom_component_safe {} {cast result} h h'"
 proof -
   have "object_ptr_kinds h' = {|cast result|} |\<union>| object_ptr_kinds h"
     using assms(4) assms(5) local.create_document_def new_document_new_ptr by blast
   have "result |\<notin>| document_ptr_kinds h"
     using assms(4) assms(5) local.create_document_def new_document_ptr_not_in_heap by auto
   show ?thesis
     using assms
     apply(auto simp add: is_weakly_scdom_component_safe_def Let_def)[1]
     using \<open>object_ptr_kinds h' = {|cast result|} |\<union>| object_ptr_kinds h\<close> apply(auto)[1]
       apply (simp add: local.create_document_def new_document_ptr_in_heap)
     using \<open>result |\<notin>| document_ptr_kinds h\<close> apply auto[1]
 
     apply (metis (no_types, lifting) \<open>result |\<notin>| document_ptr_kinds h\<close> document_ptr_kinds_commutes
         local.create_document_is_weakly_dom_component_safe_step select_result_I2)
     done
 qed
 end
 
 interpretation i_get_scdom_component_create_document?: l_get_scdom_component_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_owner_document heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe get_dom_component
   is_strongly_dom_component_safe is_weakly_dom_component_safe to_tree_order get_parent get_parent_locs
   get_child_nodes get_child_nodes_locs get_root_node get_root_node_locs get_ancestors get_ancestors_locs
   get_element_by_id get_elements_by_class_name get_elements_by_tag_name create_document
   get_disconnected_nodes get_disconnected_nodes_locs
   by(auto simp add: l_get_scdom_component_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_scdom_component_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>insert\_before\<close>
 
 locale l_get_dom_component_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_remove_child\<^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_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^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 +
   l_get_owner_document_wf +
   l_get_dom_component_get_scdom_component +
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_child_nodes_get_disconnected_nodes +
   l_remove_child +
   l_get_root_node_wf +
   l_set_disconnected_nodes_get_disconnected_nodes_wf +
   l_set_disconnected_nodes_get_ancestors +
   l_get_ancestors_wf +
   l_get_owner_document +
   l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma insert_before_is_component_unsafe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> insert_before ptr' child ref \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component ptr'|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast child)|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast |h \<turnstile> get_owner_document ptr'|\<^sub>r)|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_dom_component (cast |h \<turnstile> get_owner_document (cast child)|\<^sub>r)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   obtain owner_document 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"
     using assms(4)
     by(auto simp add: local.adopt_node_def insert_before_def elim!:  bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF ensure_pre_insertion_validity_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] split: if_splits)
   then
   obtain c where "h \<turnstile> get_dom_component (cast owner_document) \<rightarrow>\<^sub>r c"
     using get_dom_component_ok assms(1) assms(2) assms(3) get_owner_document_owner_document_in_heap
     by (meson document_ptr_kinds_commutes select_result_I)
   then
   have "ptr \<noteq> cast owner_document"
     using assms(6) assms(1) assms(2) assms(3) local.get_dom_component_ptr owner_document
     by (metis (no_types, lifting) assms(8) select_result_I2)
 
   obtain owner_document' where owner_document': "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document'"
     using assms(4)
     by(auto simp add: local.adopt_node_def insert_before_def elim!:  bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF ensure_pre_insertion_validity_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
         bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] split: if_splits)
   then
   obtain c where "h \<turnstile> get_dom_component (cast owner_document') \<rightarrow>\<^sub>r c"
     using get_dom_component_ok assms(1) assms(2) assms(3) get_owner_document_owner_document_in_heap
     by (meson document_ptr_kinds_commutes select_result_I)
   then
   have "ptr \<noteq> cast owner_document'"
     using assms(1) assms(2) assms(3) assms(7) local.get_dom_component_ptr owner_document' by auto
   then
   have "ptr \<noteq> cast |h \<turnstile> get_owner_document ptr'|\<^sub>r"
     using owner_document' by auto
 
   have "ptr \<noteq> ptr'"
     by (metis (mono_tags, opaque_lifting) assms(1) assms(2) assms(3) assms(5) assms(7) is_OK_returns_result_I
         l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_dom_component_ok l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_dom_component_ptr
         l_get_owner_document.get_owner_document_ptr_in_heap local.l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
         local.l_get_owner_document_axioms owner_document' return_returns_result returns_result_select_result)
   have "\<And>parent. h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent \<Longrightarrow> parent \<noteq> ptr"
     by (meson assms(1) assms(2) assms(3) assms(6) l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_dom_component_ptr
         local.get_dom_component_ok local.get_dom_component_to_tree_order local.get_parent_parent_in_heap
         local.l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms local.to_tree_order_ok local.to_tree_order_parent
         local.to_tree_order_ptr_in_result local.to_tree_order_ptrs_in_heap returns_result_select_result)
   then
   have "\<And>parent. |h \<turnstile> get_parent child|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr"
     by (metis assms(2) assms(3) assms(4) is_OK_returns_heap_I local.get_parent_ok
         local.insert_before_child_in_heap select_result_I)
 
   show ?thesis
     using insert_before_writes assms(4)
     apply(rule reads_writes_preserved2)
     apply(auto simp add: insert_before_locs_def adopt_node_locs_def all_args_def)[1]
             apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
             apply (metis \<open>ptr \<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 |h \<turnstile> get_owner_document ptr'|\<^sub>r\<close>
         get_M_Mdocument_preserved3)
            apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
            apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
           apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
            apply (metis \<open>ptr \<noteq> ptr'\<close> document_ptr_casts_commute3 get_M_Mdocument_preserved3)
           apply(auto split: option.splits)[1] 
           apply (metis \<open>ptr \<noteq> ptr'\<close> element_ptr_casts_commute3 get_M_Element_preserved8)
          apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def set_disconnected_nodes_locs_def
         all_args_def split: if_splits)[1]
          apply (metis \<open>ptr \<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 |h \<turnstile> get_owner_document ptr'|\<^sub>r\<close> get_M_Mdocument_preserved3)
         apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
             apply (metis (no_types, lifting) \<open>\<And>parent. |h \<turnstile> get_parent child|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>
         element_ptr_casts_commute3 get_M_Element_preserved8 node_ptr_casts_commute option.case_eq_if option.collapse)
            apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
           apply (metis \<open>\<And>parent. |h \<turnstile> get_parent child|\<^sub>r = Some parent \<Longrightarrow> parent \<noteq> ptr\<close>
         document_ptr_casts_commute3 get_M_Mdocument_preserved3)
          apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
         apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
        apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
        apply (metis \<open>ptr \<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 |h \<turnstile> get_owner_document ptr'|\<^sub>r\<close>
         get_M_Mdocument_preserved3)
       apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
       apply (metis (no_types, lifting) \<open>ptr \<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 owner_document\<close>
         get_M_Mdocument_preserved3 owner_document select_result_I2)
      apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
       apply (metis \<open>ptr \<noteq> ptr'\<close> document_ptr_casts_commute3 get_M_Mdocument_preserved3)
      apply (metis (no_types, lifting) \<open>ptr \<noteq> ptr'\<close> element_ptr_casts_commute3
         get_M_Element_preserved8 node_ptr_casts_commute option.case_eq_if option.collapse)
     apply(auto simp add: remove_child_locs_def set_child_nodes_locs_def
         set_disconnected_nodes_locs_def all_args_def split: if_splits)[1]
     by (metis \<open>ptr \<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 |h \<turnstile> get_owner_document ptr'|\<^sub>r\<close> get_M_Mdocument_preserved3)
 qed
 
 lemma insert_before_is_strongly_dom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> insert_before ptr' child ref \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component ptr'|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast child)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
 proof -
   have "ptr' |\<in>| object_ptr_kinds h"
     by (meson assms(4) is_OK_returns_heap_I local.insert_before_ptr_in_heap)
   then
   obtain sc' where sc': "h \<turnstile> get_scdom_component ptr' \<rightarrow>\<^sub>r sc'"
     by (meson assms(1) assms(2) assms(3) get_scdom_component_ok is_OK_returns_result_E)
   moreover
   obtain c' where c': "h \<turnstile> get_dom_component ptr' \<rightarrow>\<^sub>r c'"
     by (meson \<open>ptr' |\<in>| object_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.get_dom_component_ok)
   ultimately have "set c' \<subseteq> set sc'"
     using assms(1) assms(2) assms(3) get_scdom_component_subset_get_dom_component by blast
 
   have "child |\<in>| node_ptr_kinds h"
     by (meson assms(4) is_OK_returns_heap_I local.insert_before_child_in_heap)
   then
   obtain child_sc where child_sc: "h \<turnstile> get_scdom_component (cast child) \<rightarrow>\<^sub>r child_sc"
     by (meson assms(1) assms(2) assms(3) get_scdom_component_ok is_OK_returns_result_E
         node_ptr_kinds_commutes)
   moreover
   obtain child_c where child_c: "h \<turnstile> get_dom_component (cast child) \<rightarrow>\<^sub>r child_c"
     by (meson \<open>child |\<in>| node_ptr_kinds h\<close> assms(1) assms(2) assms(3) is_OK_returns_result_E
         local.get_dom_component_ok node_ptr_kinds_commutes)
   ultimately have "set child_c \<subseteq> set child_sc"
     using assms(1) assms(2) assms(3) get_scdom_component_subset_get_dom_component by blast
 
   obtain ptr'_owner_document where ptr'_owner_document: "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r ptr'_owner_document"
     by (meson \<open>set c' \<subseteq> set sc'\<close> assms(1) assms(2) assms(3) c' get_scdom_component_owner_document_same
         local.get_dom_component_ptr sc' subset_code(1))
   then
   have "h \<turnstile> get_scdom_component (cast ptr'_owner_document) \<rightarrow>\<^sub>r sc'"
     by (metis (no_types, lifting) \<open>set c' \<subseteq> set sc'\<close> assms(1) assms(2) assms(3) c'
         get_scdom_component_owner_document_same get_scdom_component_ptrs_same_scope_component
         local.get_dom_component_ptr sc' select_result_I2 subset_code(1))
   moreover
   obtain ptr'_owner_document_c where ptr'_owner_document_c:
     "h \<turnstile> get_dom_component (cast ptr'_owner_document) \<rightarrow>\<^sub>r ptr'_owner_document_c"
     by (meson assms(1) assms(2) assms(3) document_ptr_kinds_commutes is_OK_returns_result_E
         local.get_dom_component_ok local.get_owner_document_owner_document_in_heap ptr'_owner_document)
   ultimately have "set ptr'_owner_document_c \<subseteq> set sc'"
     using assms(1) assms(2) assms(3) get_scdom_component_subset_get_dom_component by blast
 
   obtain child_owner_document where child_owner_document: "h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r child_owner_document"
     by (meson \<open>set child_c \<subseteq> set child_sc\<close> assms(1) assms(2) assms(3) child_c child_sc
         get_scdom_component_owner_document_same local.get_dom_component_ptr subset_code(1))
 
   have "child_owner_document |\<in>| document_ptr_kinds h"
     using assms(1) assms(2) assms(3) child_owner_document local.get_owner_document_owner_document_in_heap
     by blast
   then
   have "h \<turnstile> get_scdom_component (cast child_owner_document) \<rightarrow>\<^sub>r child_sc"
     using get_scdom_component_ok assms(1) assms(2) assms(3) child_sc
     by (metis (no_types, lifting) \<open>set child_c \<subseteq> set child_sc\<close> child_c child_owner_document
         get_scdom_component_owner_document_same get_scdom_component_ptrs_same_scope_component
         local.get_dom_component_ptr returns_result_eq set_mp)
   moreover
   obtain child_owner_document_c where child_owner_document_c:
     "h \<turnstile> get_dom_component (cast child_owner_document) \<rightarrow>\<^sub>r child_owner_document_c"
     by (meson assms(1) assms(2) assms(3) child_owner_document document_ptr_kinds_commutes
         is_OK_returns_result_E local.get_dom_component_ok local.get_owner_document_owner_document_in_heap)
   ultimately have "set child_owner_document_c \<subseteq> set child_sc"
     using assms(1) assms(2) assms(3) get_scdom_component_subset_get_dom_component by blast
 
 
   have "ptr \<notin> set |h \<turnstile> get_dom_component ptr'|\<^sub>r"
     using \<open>set c' \<subseteq> set sc'\<close> assms(5) c' sc' by auto
   moreover have "ptr \<notin> set |h \<turnstile> get_dom_component (cast child)|\<^sub>r"
     using \<open>set child_c \<subseteq> set child_sc\<close> assms(6) child_c child_sc by auto
   moreover have "ptr \<notin> set |h \<turnstile> get_dom_component (cast |h \<turnstile> get_owner_document ptr'|\<^sub>r)|\<^sub>r"
     using \<open>set ptr'_owner_document_c \<subseteq> set sc'\<close> assms(5) ptr'_owner_document ptr'_owner_document_c sc'
     by auto
   moreover have "ptr \<notin> set |h \<turnstile> get_dom_component (cast |h \<turnstile> get_owner_document (cast child)|\<^sub>r)|\<^sub>r"
     using \<open>set child_owner_document_c \<subseteq> set child_sc\<close> assms(6) child_owner_document child_owner_document_c
       child_sc by auto
 
   ultimately show ?thesis
     using assms insert_before_is_component_unsafe
     by blast
 qed
 
 lemma insert_before_is_strongly_dom_component_safe:
   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 "is_strongly_scdom_component_safe ({ptr, cast node} \<union> (case child of Some ref \<Rightarrow> {cast ref} | None \<Rightarrow> {} )) {} h h'"
 proof -
   obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors 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)
 
   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 "known_ptrs h2"
     using assms(3) object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF assms(1) h2] assms(3) assms(2) .
 
   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 "known_ptrs h3"
     using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \<open>known_ptrs h2\<close> by blast
 
   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 "object_ptr_kinds h = object_ptr_kinds h'"
     by (simp add: object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2)
   then
   show ?thesis
     using assms
     apply(auto simp add: is_strongly_scdom_component_safe_def)[1]
     using insert_before_is_strongly_dom_component_safe_step local.get_scdom_component_impl by blast
 qed
 
 lemma append_child_is_strongly_dom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> append_child ptr' child \<rightarrow>\<^sub>h h'"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component ptr'|\<^sub>r"
   assumes "ptr \<notin> set |h \<turnstile> get_scdom_component (cast child)|\<^sub>r"
   shows "preserved (get_M ptr getter) h h'"
   by (metis assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
       insert_before_is_strongly_dom_component_safe_step local.append_child_def)
 
 lemma append_child_is_strongly_dom_component_safe:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> append_child ptr child \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr, cast child} {} h h'"
   using assms unfolding append_child_def
   using insert_before_is_strongly_dom_component_safe
   by fastforce
 end
 
 interpretation i_get_dom_component_insert_before?: l_get_dom_component_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs to_tree_order get_parent
   get_parent_locs get_child_nodes get_child_nodes_locs get_dom_component is_strongly_dom_component_safe
   is_weakly_dom_component_safe get_root_node get_root_node_locs get_ancestors get_ancestors_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_element_by_id get_elements_by_class_name
   get_elements_by_tag_name set_child_nodes set_child_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs
   get_owner_document remove_child remove_child_locs remove adopt_node adopt_node_locs insert_before
   insert_before_locs append_child get_scdom_component is_strongly_scdom_component_safe
   is_weakly_scdom_component_safe
   by(auto simp add: l_get_dom_component_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_dom_component_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document_scope_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_scdom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_dom_component_get_scdom_component +
   l_get_owner_document_wf_get_root_node_wf
 begin
 lemma get_owner_document_is_strongly_scdom_component_safe_step:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_scdom_component ptr \<rightarrow>\<^sub>r sc"
   assumes "h \<turnstile> get_owner_document ptr' \<rightarrow>\<^sub>r owner_document"
   shows "cast owner_document \<in> set sc \<longleftrightarrow> ptr' \<in> set sc"
 proof -
   have "h \<turnstile> get_owner_document (cast owner_document) \<rightarrow>\<^sub>r owner_document"
     by (metis assms(1) assms(2) assms(3) assms(5) 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_inject
         document_ptr_casts_commute3 document_ptr_document_ptr_cast document_ptr_kinds_commutes
         local.get_owner_document_owner_document_in_heap local.get_root_node_document
         local.get_root_node_not_node_same node_ptr_no_document_ptr_cast)
   then show ?thesis
     using assms
     using bind_returns_result_E contra_subsetD get_scdom_component_ok
       get_scdom_component_ptrs_same_scope_component get_scdom_component_subset_get_dom_component
       is_OK_returns_result_E is_OK_returns_result_I local.get_dom_component_ok local.get_dom_component_ptr
       local.get_owner_document_ptr_in_heap local.get_owner_document_pure local.get_scdom_component_def
       pure_returns_heap_eq returns_result_eq
     by (smt local.get_scdom_component_ptrs_same_owner_document subsetD)
 qed
 
 
 lemma get_owner_document_is_strongly_scdom_component_safe:
   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"
   assumes "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>h h'"
   shows "is_strongly_scdom_component_safe {ptr} {cast owner_document} h h'"
 proof -
   have "h = h'"
     by (meson assms(5) local.get_owner_document_pure pure_returns_heap_eq)
   then show ?thesis
     using assms
     apply(auto simp add: is_strongly_scdom_component_safe_def Let_def preserved_def)[1]
     by (smt get_owner_document_is_strongly_scdom_component_safe_step inf.orderE is_OK_returns_result_I
         local.get_dom_component_ok local.get_dom_component_to_tree_order_subset local.get_owner_document_ptr_in_heap
         local.get_scdom_component_impl local.get_scdom_component_ok local.get_scdom_component_ptr_in_heap
         local.get_scdom_component_subset_get_dom_component local.to_tree_order_ok
         local.to_tree_order_ptr_in_result notin_fset returns_result_select_result subset_eq)
 qed
 end
 
 interpretation i_get_owner_document_scope_component?: l_get_owner_document_scope_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_scdom_component is_strongly_scdom_component_safe is_weakly_scdom_component_safe
   get_owner_document get_disconnected_nodes get_disconnected_nodes_locs to_tree_order known_ptr
   known_ptrs type_wf heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs
   get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs
   get_dom_component is_strongly_dom_component_safe is_weakly_dom_component_safe get_element_by_id
   get_elements_by_class_name get_elements_by_tag_name
   by(auto simp add: l_get_owner_document_scope_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_owner_document_scope_component\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 end
diff --git a/thys/Virtual_Substitution/EliminateVariable.thy b/thys/Virtual_Substitution/EliminateVariable.thy
--- a/thys/Virtual_Substitution/EliminateVariable.thy
+++ b/thys/Virtual_Substitution/EliminateVariable.thy
@@ -1,683 +1,683 @@
 subsection "Lemmas of the elimVar function"
 
 theory EliminateVariable
   imports LinearCase QuadraticCase  "HOL-Library.Quadratic_Discriminant"
 begin
 
 
 
 
 lemma elimVar_eq :
   assumes hlength : "length xs = var"
   assumes in_list : "Eq p \<in> set(L)"
   assumes low_pow : "MPoly_Type.degree p var = 1 \<or> MPoly_Type.degree p var = 2"
   shows "((\<exists>x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)) =
     ((\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>)))\<or> (\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>)))"
 proof-
 
   { fix x
     define A where "A = (isolate_variable_sparse p var 2)"
     define B where "B = (isolate_variable_sparse p var 1)"
     define C where "C = (isolate_variable_sparse p var 0)"
     have freeA : "var \<notin> vars A"
       unfolding A_def
       by (simp add: not_in_isovarspar)
     have freeB : "var \<notin> vars B"
       unfolding B_def
       by (simp add: not_in_isovarspar)
     have freeC : "var \<notin> vars C"
       unfolding C_def
       by (simp add: not_in_isovarspar)
     assume "eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)"
     then have h : "(\<forall>a\<in>set L. aEval a (xs @ x # \<Gamma>)) \<and> (\<forall>f\<in>set F. eval f (xs @ x # \<Gamma>))"
       apply(simp add:eval_list_conj)
       by (meson Un_iff eval.simps(1) image_eqI)
     define X where "X=xs@x#\<Gamma>"
     have Xlength : "length X > var"
       using X_def hlength by auto
     define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A"
     define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B"
     define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C"
     have hinsert : "(xs @ x # \<Gamma>)[var := x] = (xs @ x #\<Gamma>)"
       using hlength by auto
     have allAval : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) A = Aval"
       using Aval_def
       using not_contains_insertion[where var="var", where p = "A", OF freeA, where L = "xs @ x #\<Gamma>", where x="x", where val="Aval"]
       unfolding X_def hinsert using hlength by auto
     have allBval : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) B = Bval"
       using Bval_def
       using not_contains_insertion[where var="var", where p = "B", OF freeB, where L = "xs @ x #\<Gamma>", where x="x", where val="Bval"]
       unfolding X_def hinsert using hlength by auto
     have allCval : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) C = Cval"
       using Cval_def
       using not_contains_insertion[where var="var", where p = "C", OF freeC, where L = "xs @ x #\<Gamma>", where x="x", where val="Cval"]
       unfolding X_def hinsert using hlength by auto
     have insertion_p : "insertion (nth_default 0 X) p = 0"
       using in_list h aEval.simps(1) X_def by fastforce
     have express_p : "p = A * Var var ^ 2 + B * Var var + C"
       using express_poly[OF low_pow] unfolding A_def B_def C_def
       by fastforce
     have insertion_p' : "Aval *x^2+Bval *x+Cval = 0"
       using express_p insertion_p unfolding Aval_def Bval_def Cval_def X_def hinsert
       apply(simp add: insertion_add insertion_mult insertion_pow)
       using  insertion_var by (metis X_def Xlength hinsert) 
     have biglemma : "
        ((Aval = 0 \<and>
         Bval \<noteq> 0 \<and>
         (\<forall>f\<in>set L. aEval (linear_substitution var (-C) B f) (xs @ x # \<Gamma>)) \<and> 
         (\<forall>f\<in>set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # \<Gamma>)) \<or>
         Aval \<noteq> 0 \<and>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) 4 * 
         Aval *
         Cval
         \<le> (Bval)\<^sup>2 \<and>
         ((\<forall>f\<in>set L. eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>))\<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<or>
          (\<forall>f\<in>set L. eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>))) \<or>
         Aval = 0 \<and>
         Bval = 0 \<and>
         Cval = 0))"
     proof(cases "Aval=0")
       case True
       then have aval0 : "Aval=0" by simp
       show ?thesis proof(cases "Bval=0")
         case True
         then have bval0 :  "Bval=0" by simp
         have h : "eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)"
           using hlength h unfolding X_def
           using \<open>eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)\<close> by blast
         show ?thesis proof(cases "Cval=0")
           case True
           show ?thesis                                  
             by(simp add:aval0 True bval0)
         next
           case False
           show ?thesis
             using insertion_p' aval0 bval0 False by(simp)
         qed
       next
         case False
         have bh : "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval"
           using allBval unfolding X_def
           using Bval_def X_def freeB not_contains_insertion by blast
         have ch : "insertion (nth_default 0 (X[var := - Cval / Bval])) C = Cval"
           using allCval unfolding X_def
           using Cval_def X_def freeC not_contains_insertion by blast
         have xh : "x=-Cval/Bval"
         proof-
           have "Bval*x+Cval = 0"
             using insertion_p' aval0
             by simp
           then show ?thesis using False
             by (smt nonzero_mult_div_cancel_left)
         qed
         have freecneg : "var \<notin> vars (-C)" using freeC not_in_neg by auto
         have h1:  "(\<forall>a\<in>set L. aEval (linear_substitution var (-C) (B) a) (X[var := x]))"
           using h xh Bval_def Cval_def False LinearCase.linear[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC freecneg
           by (metis X_def hinsert insertion_neg)
         have h2 : "\<forall>f\<in>set F. eval (linear_substitution_fm var (-C) B f) (X[var := x])"
           using h xh Bval_def Cval_def False LinearCase.linear_fm[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC
           by (metis X_def hinsert insertion_neg)
         show ?thesis using h1 h2 apply(simp add:aval0 False)
           using X_def hlength
           using hinsert by auto
       qed
     next
       case False
       then have aval0 : "Aval \<noteq>0" by simp
       have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4"
         using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"]
         by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one)
       show ?thesis proof(cases "4 * Aval * Cval \<le> Bval\<^sup>2")
         case True
         have h1a : "var\<notin>vars(-B)"
           by(simp add: freeB not_in_neg)
         have h1b : "var\<notin>vars(1::real mpoly)"
           using isolate_var_one not_in_isovarspar by blast
         have h1c : "var\<notin>vars(-1::real mpoly)"
           by(simp add: h1b not_in_neg)
         have h1d : "var\<notin>vars(4::real mpoly)"
           by (metis h1b not_in_add numeral_Bit0 one_add_one)
         have h1e : "var\<notin>vars(B^2-4*A*C)" 
           by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub)
         have h1f : "var\<notin>vars(2::real mpoly)"
           using h1b not_in_add by fastforce
         have h1g : "var\<notin>vars(2*A)"
           by(simp add: freeA h1f not_in_mult)
         have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)"
           using free_in_quad h1a h1b h1e h1g by blast
         have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)"
           using free_in_quad h1a h1c h1e h1g by blast 
         have h2 : "2*Aval \<noteq> 0" using aval0 by auto
         have h3 : "0 \<le> (Bval^2-4*Aval*Cval)" using True by auto
         have h4a : "var \<notin> vars 4"
           by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) 
         have h4 : "var \<notin> vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub)  
         have h5 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " 
           using allBval apply(simp add: insertion_neg)
           by (simp add: B_def Bval_def insertion_isovarspars_free)
         have h6 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp
         have h6a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) 
         have h7a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one)
         have h7b : "var \<notin> vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) 
         have h7c : "var \<notin> vars(B^2)" using freeB not_in_pow by auto
         have h7 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)"
           using h7a allAval allBval allCval unfolding X_def  using hlength 
           apply (simp add: insertion_mult insertion_sub power2_eq_square)
           by (metis A_def Aval_def Bval_def C_def Cval_def X_def freeB insertion_isovarspars_free not_contains_insertion)
         have h8a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one)
         have h8 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)"
           apply(simp add: allAval h8a insertion_mult)
           by (simp add: A_def Aval_def insertion_isovarspars_free)
 
         have h1 : "- Bval\<^sup>2 + 4 * Aval * Cval \<le> 0"
           using True by simp
         have xh : "x = (- Bval + sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)\<or>x=(- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)"
           using insertion_p' aval0 h1
             discriminant_iff unfolding discrim_def by blast
         have p1 : "x = (- Bval + sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval) \<Longrightarrow> 
                                                             ((\<forall>a\<in> set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                                                       \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))"
         proof-
           assume x_def : "x = (- Bval + sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)"
           then have h : "(\<forall>a\<in>set L. aEval a (X[var := (- Bval + sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)])) \<and> (\<forall>f\<in>set F. eval f (X[var := (- Bval + sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)]))"
             using h
             using X_def hinsert by auto
           { fix a
             assume in_list : "a\<in> set L"
             have "eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x])"
               using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
               using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                   where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                   h in_list
               using var_not_in_eval by fastforce 
 
           }
           then have left : "(\<forall>a\<in>set L. eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x]))"
             by simp
 
 
           { fix a
             assume in_list : "a\<in> set F"
             have "eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x])"
               using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
               using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                   where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                   h in_list
               using var_not_in_eval by fastforce 
 
           }
           then have right : "(\<forall>a\<in>set F. eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x]))"
             by simp
           show ?thesis
             using right left by simp
         qed
 
         have p2 : "x = (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval) \<Longrightarrow> 
                                                             ((\<forall>a\<in> set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                                                       \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])))"
         proof -
           assume x_def : "x = (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)"
           then have h : "(\<forall>a\<in>set L. aEval a (X[var := (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)])) \<and> (\<forall>f\<in>set F. eval f (X[var := (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)]))"
             using h
             using X_def hinsert by auto
           then have "(\<forall>a\<in>set L. aEval a (X[var := (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)])) \<and> (\<forall>f\<in>set F. eval f (X[var := (- Bval - sqrt (Bval\<^sup>2 - 4 * Aval * Cval)) / (2 * Aval)]))"
             using h  by simp
           { fix a
             assume in_list : "a\<in> set L"
             have "eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x])"
               using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
               using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                   where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
                   h in_list
               using var_not_in_eval by fastforce 
 
           }
           then have left : "(\<forall>a\<in>set L. eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x]))"
             by simp
 
 
           { fix a
             assume in_list : "a\<in> set F"
             have "eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x])"
               using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
               using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                   where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
                   h in_list
               using var_not_in_eval by fastforce 
 
           }
           then have right : "(\<forall>a\<in>set F. eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (X[var := x]))"
             by simp
           show ?thesis
             using right left by simp
         qed
         have subst4 : "insertion (nth_default 0 (xs @ x # \<Gamma>)) 4 = 4" using h7a hlength X_def by auto 
         have disj: "(\<forall>a\<in>set L. eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (xs @ x # \<Gamma>)) \<and>
                                                             (\<forall>a\<in>set F. eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) a) (xs @ x # \<Gamma>)) \<or> 
                                                             (\<forall>a\<in>set L. eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (xs @ x # \<Gamma>)) \<and>
                                                             (\<forall>a\<in>set F. eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) a) (xs @ x # \<Gamma>))"
           using xh p1 p2
           unfolding X_def hinsert  by blast
         show ?thesis apply(simp add: aval0 True h7a subst4) using disj
           unfolding X_def hinsert by auto
       next
         case False
         then have det : "0 < - Bval\<^sup>2 + 4 * Aval * Cval"
           by simp
         show ?thesis apply(simp add: aval0 False h4) using discriminant_negative unfolding discrim_def
           using insertion_p'
           using aval0 det by auto 
       qed
     qed
     have "(\<exists>x.
        (insertion (nth_default 0 (xs @ x # \<Gamma>)) A = 0 \<and>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) B \<noteq> 0 \<and>
         (\<forall>f\<in>set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # \<Gamma>)) \<and> 
         (\<forall>f\<in>set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # \<Gamma>)) \<or>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) A \<noteq> 0 \<and>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) 4 * 
         insertion (nth_default 0 (xs @ x # \<Gamma>)) A *
         insertion (nth_default 0 (xs @ x # \<Gamma>)) C
         \<le> (insertion (nth_default 0 (xs @ x # \<Gamma>)) B)\<^sup>2 \<and>
         ((\<forall>f\<in>set L. eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>))\<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<or>
          (\<forall>f\<in>set L. eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)))) \<or>
         (Aval = 0 \<and>
         Bval = 0 \<and>
         Cval = 0))"
       apply(rule exI[where x=x])
       using biglemma
       using allAval allBval allCval unfolding A_def B_def C_def Aval_def Bval_def Cval_def X_def hinsert
       by auto
     then obtain x where x : "(insertion (nth_default 0 (xs @ x # \<Gamma>)) A = 0 \<and>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) B \<noteq> 0 \<and>
         (\<forall>f\<in>set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # \<Gamma>)) \<and> 
         (\<forall>f\<in>set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # \<Gamma>)) \<or>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) A \<noteq> 0 \<and>
         insertion (nth_default 0 (xs @ x # \<Gamma>)) 4 * 
         insertion (nth_default 0 (xs @ x # \<Gamma>)) A *
         insertion (nth_default 0 (xs @ x # \<Gamma>)) C
         \<le> (insertion (nth_default 0 (xs @ x # \<Gamma>)) B)\<^sup>2 \<and>
         ((\<forall>f\<in>set L. eval (quadratic_sub var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>))\<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) 1 (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<or>
          (\<forall>f\<in>set L. eval (quadratic_sub var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)) \<and>
          (\<forall>f\<in>set F. eval (quadratic_sub_fm var (- B) (-1) (B\<^sup>2 - 4 * A * C) (2 * A) f) (xs @ x # \<Gamma>)))) \<or>
         (Aval = 0 \<and>
         Bval = 0 \<and>
         Cval = 0)" by auto
     have h : "(\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))\<or>(Aval = 0 \<and> Bval = 0 \<and> Cval = 0)"
     proof(cases "(Aval = 0 \<and> Bval = 0 \<and> Cval = 0)")
       case True
       then show ?thesis by simp
     next
       case False
       have "(\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))"
         apply(rule exI[where x=x])
         apply(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add 
             del:  quadratic_sub.simps linear_substitution.simps quadratic_sub_fm.simps linear_substitution_fm.simps)
         unfolding A_def[symmetric] B_def[symmetric] C_def[symmetric] One_nat_def[symmetric] X_def[symmetric]
         using hlength x
         by (auto simp add:False)
       then show ?thesis by auto
     qed
     have "(\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))\<or>(\<forall>x. aEval (Eq p) (xs@ x# \<Gamma>))"
     proof(cases "(\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))")
       case True
       then show ?thesis by auto
     next
       case False
       then have "(Aval = 0 \<and> Bval = 0 \<and> Cval = 0)"
         using h by auto
       then have "(\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>))"
         unfolding express_p
         apply(simp add:insertion_add insertion_mult insertion_pow)
         using allAval allBval allCval by auto 
       then show ?thesis by auto
     qed
   }
   then have left : "(\<exists>x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)) \<Longrightarrow>
                         ((\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))\<or>(\<forall>x. aEval (Eq p) (xs@ x# \<Gamma>)))"
     by blast
 
 
   {
     assume hlength : "length (xs::real list) = var"
     define A where "A = (isolate_variable_sparse p var 2)"
     define B where "B = (isolate_variable_sparse p var 1)"
     define C where "C = (isolate_variable_sparse p var 0)"
     have freeA : "var \<notin> vars A"
       unfolding A_def
       by (simp add: not_in_isovarspar)
     have freeB : "var \<notin> vars B"
       unfolding B_def
       by (simp add: not_in_isovarspar)
     have freeC : "var \<notin> vars C"
       unfolding C_def
       by (simp add: not_in_isovarspar)
     have express_p : "p = A*(Var var)^2+B*(Var var)+C"
       using express_poly[OF low_pow] unfolding A_def B_def C_def
       by fastforce
     assume h : "(\<exists>x. (eval (elimVar var L F (Eq p)) (list_update (xs@x#\<Gamma>) var x)))"
     fix x
     define X where "X=xs@x#\<Gamma>"
     have Xlength : "length X > var"
       using X_def hlength by auto
     define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A"
     define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B"
     define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C"
     have allAval : "\<forall>x. insertion (nth_default 0 (list_update X var x)) A = Aval"
       using freeA Aval_def
       using not_contains_insertion by blast
     have allBval : "\<forall>x. insertion (nth_default 0 (list_update X var x)) B = Bval"
       using freeB Bval_def
       using not_contains_insertion by blast
     have allCval : "\<forall>x. insertion (nth_default 0 (list_update X var x)) C = Cval"
       using freeC Cval_def
       using not_contains_insertion by blast
     assume "(eval (elimVar var L F (Eq p)) (list_update (xs@x#\<Gamma>) var x))"
     then have h : "(eval (elimVar var L F (Eq p)) (list_update X var x))"
       unfolding X_def .
 
     have "(Aval = 0 \<and> Bval \<noteq> 0 \<and>
           (\<forall>f\<in>(\<lambda>a. Atom(linear_substitution var (-C) B a)) ` set L \<union>
              linear_substitution_fm var (-C) B `
              set F.
             eval f (X[var := x])) \<or>
           Aval \<noteq> 0 \<and>
           insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval  \<le> Bval\<^sup>2 \<and>
           ((\<forall>f\<in>(quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A)) `
              set L \<union>
              (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A)) `
              set F.
             eval f (X[var := x]))
           \<or>(\<forall>f\<in>(quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A)) `
              set L \<union>
              (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A)) `
              set F.
             eval f (X[var := x]))
           ))"
       unfolding Aval_def Bval_def Cval_def A_def B_def C_def
       using h by(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add insertion_var Xlength)
     then have h : "(Aval = 0 \<and> Bval \<noteq> 0 \<and>
                             ((\<forall>a\<in> set L. aEval (linear_substitution var (-C) B a) (X[var := x])) \<and>
                             (\<forall>a\<in> set F. eval (linear_substitution_fm var (-C) B a) (X[var := x]))) \<or>
                             Aval \<noteq> 0 \<and> insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval \<le> Bval\<^sup>2 \<and>
                             (((\<forall>a\<in> set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                             \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))
                             \<or>((\<forall>a\<in> set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                             \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])))))
                           "
       apply(cases "Aval = 0 ")
       apply auto
       by (meson Un_iff eval.simps(1) imageI)
     have h : "(\<exists>x. ((\<forall>a\<in>set L . aEval a ((xs@x#\<Gamma>)[var := x])) \<and> (\<forall>f\<in>set F. eval f ((xs@x#\<Gamma>)[var := x]))))\<or>(Aval=0\<and>Bval=0\<and>Cval=0)"
     proof(cases "Aval=0")
       case True
       then have aval0 : "Aval=0"
         by simp
       show ?thesis proof(cases "Bval = 0")
         case True
         then have bval0 : "Bval = 0" by simp
         show ?thesis proof(cases "Cval=0")
           case True
           then show ?thesis using aval0 bval0 True by auto
         next
           case False
           then show ?thesis using h by(simp add:aval0 bval0 False)
         qed 
       next
         case False
         have hb :  "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval"
           using allBval by simp
         have hc : "insertion (nth_default 0 (X[var := - Cval / Bval])) (-C) = -Cval"
           using allCval
           by (simp add: insertion_neg) 
         have freecneg : "var\<notin>vars(-C)" using freeC not_in_neg by auto
         have p1 : "(\<forall>a\<in>set L. aEval a ((xs @ x # \<Gamma>)[var := - Cval / Bval]))"
           using h apply(simp add: False aval0)
           using linear[OF Xlength False freecneg freeB hc hb]
             list_update_length var_not_in_linear[OF freecneg freeB]
           unfolding X_def using hlength
           by (metis divide_minus_left)
 
         have p2 : "(\<forall>a\<in>set F. eval a ((xs @ x # \<Gamma>)[var := - Cval / Bval]))"
           using h apply(simp add: False aval0)
           using linear_fm[OF Xlength False freecneg freeB hc hb]
             list_update_length var_not_in_linear_fm[OF freecneg freeB]
           unfolding X_def using hlength var_not_in_eval
           by (metis divide_minus_left linear_substitution_fm.elims linear_substitution_fm_helper.elims)
         show ?thesis 
           using p1 p2 hlength by fastforce
       qed
     next
       case False
       then have aval0 : "Aval \<noteq> 0"
         by simp
       have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4"
         using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"]
         by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one)
       show ?thesis proof(cases "4 * Aval * Cval \<le> Bval\<^sup>2")
         case True
         then have h1 :  "- Bval\<^sup>2 + 4 * Aval * Cval \<le> 0"
           by simp
         have h : "(((\<forall>a\<in> set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                         \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))
                         \<or>((\<forall>a\<in> set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                         \<and>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))))"
           using h by(simp add: h1 aval0)
         have h1a : "var\<notin>vars(-B)"
           by(simp add: freeB not_in_neg)
         have h1b : "var\<notin>vars(1::real mpoly)"
           using isolate_var_one not_in_isovarspar by blast
         have h1c : "var\<notin>vars(-1::real mpoly)"
           by(simp add: h1b not_in_neg)
         have h1d : "var\<notin>vars(4::real mpoly)"
           by (metis h1b not_in_add numeral_Bit0 one_add_one)
         have h1e : "var\<notin>vars(B^2-4*A*C)" 
           by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub)
         have h1f : "var\<notin>vars(2::real mpoly)"
           using h1b not_in_add by fastforce
         have h1g : "var\<notin>vars(2*A)"
           by(simp add: freeA h1f not_in_mult)
         have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)"
           using free_in_quad h1a h1b h1e h1g by blast
         have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)"
           using free_in_quad h1a h1c h1e h1g by blast 
         have h2 : "2*Aval \<noteq> 0" using aval0 by auto
         have h3 : "0 \<le> (Bval^2-4*Aval*Cval)" using True by auto
         have h4a : "var \<notin> vars 4"
           by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) 
         have h4 : "var \<notin> vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub)  
         have h5 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " using allBval by(simp add: insertion_neg)
         have h6 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp
         have h6a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) 
         have h7a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one)
         have h7b : "var \<notin> vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) 
         have h7c : "var \<notin> vars(B^2)" using freeB not_in_pow by auto
         have h7 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)"
           by (simp add: h7a allAval allBval allCval insertion_mult insertion_sub power2_eq_square)
         have h8a : "\<forall>x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one)
         have h8 : "\<forall>x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)" by(simp add: allAval h8a insertion_mult)
 
         have p1 : "(\<forall>a\<in> set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                         \<Longrightarrow>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                           \<Longrightarrow> \<exists>x. length xs = var \<and> ((\<forall>a\<in>set L . aEval a ((xs@x#\<Gamma>)[var := x])) \<and> (\<forall>f\<in>set F. eval f ((xs@x#\<Gamma>)[var := x])))"
         proof-
           assume p1 : "(\<forall>a\<in> set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))"
           assume p2 : "(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))"
           show ?thesis
             using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
             using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                 where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
             using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
             using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                 where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                 p1 p2
             using var_not_in_eval
             by (metis X_def hlength list_update_length)
         qed
         have p2 : "(\<forall>a\<in> set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                         \<Longrightarrow>(\<forall>a\<in> set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                           \<Longrightarrow>\<exists>x. length xs = var \<and> ((\<forall>a\<in>set L . aEval a ((xs@x#\<Gamma>)[var := x])) \<and> (\<forall>f\<in>set F. eval f ((xs@x#\<Gamma>)[var := x])))"
           using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
           using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
               where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
 
           using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
           using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
               where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
 
           using var_not_in_eval by (metis X_def hlength list_update_length)
         then show ?thesis
           using h p1 p2 by blast
       next
         case False
         then show ?thesis using h by(simp add: aval0 False h4)
       qed
     qed
     have "(\<exists>x.((\<forall>a\<in>set L . aEval a ((xs@x#\<Gamma>)[var := x])) \<and> (\<forall>f\<in>set F. eval f ((xs@x#\<Gamma>)[var := x]))))\<or>(\<forall>x. aEval (Eq p) (xs @ x#\<Gamma>))"
     proof(cases "(\<exists>x.((\<forall>a\<in>set L . aEval a ((xs@x#\<Gamma>)[var := x])) \<and> (\<forall>f\<in>set F. eval f ((xs@x#\<Gamma>)[var := x]))))")
       case True
       then show ?thesis by auto
     next
       case False
       then have "Aval=0\<and>Bval=0\<and>Cval=0" using h by auto
       then have "(\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>))"
         unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow)
         using allAval allBval allCval hlength unfolding X_def by auto
       then show ?thesis by auto
     qed
   }
 
 
   then have right : "(\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>)) \<Longrightarrow>
                ((\<exists>x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>))\<or>(\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>)))"
     by (smt UnE eval.simps(1) eval_list_conj hlength imageE list_update_length set_append set_map)
 
 
   show ?thesis using right left by blast
 qed
 
 text "simply states that the variable is free in the equality case of the elimVar function"
 lemma freeIn_elimVar_eq : "freeIn var (elimVar var L F (Eq p))"
 proof-
   have h4 : "var \<notin> vars(4:: real mpoly)" using var_not_in_Const
     by (metis (full_types) isolate_var_one monom_numeral not_in_isovarspar numeral_One vars_monom_keys zero_neq_numeral)
   have hlinear: "\<forall>f\<in>set(map (\<lambda>a. Atom(linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) a)) L @
         map (linear_substitution_fm var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)))
          F). freeIn var f" 
     using
       var_not_in_linear[where c="(isolate_variable_sparse p var (Suc 0))", where b="(- isolate_variable_sparse p var 0)", where var="var"]
       var_not_in_linear_fm[where c="(isolate_variable_sparse p var (Suc 0))", where b="(-isolate_variable_sparse p var 0)", where var="var"]
       not_in_isovarspar not_in_neg by auto
   have freeA : "var \<notin> vars (- isolate_variable_sparse p var (Suc 0))"
     using not_in_isovarspar not_in_neg by auto
   have freeB1 : "var \<notin> vars (1::real mpoly)"
     by (metis h4 monom_numeral monom_one notInKeys_notInVars vars_monom_keys zero_neq_numeral)
   have freeC : "var \<notin> vars (((isolate_variable_sparse p var (Suc 0))\<^sup>2 -
                     4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0))"
     using not_in_isovarspar not_in_pow not_in_sub not_in_mult h4 by auto
   have freeD : "var \<notin> vars ((2 * isolate_variable_sparse p var 2))"
     using not_in_isovarspar not_in_mult
     by (metis mult_2 not_in_add) 
   have freeB2 : "var\<notin>vars (-1::real mpoly)"
     using freeB1 not_in_neg by auto
   have quadratic1 : "\<forall>f\<in>set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
               ((isolate_variable_sparse p var (Suc 0))\<^sup>2 -
                4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
               (2 * isolate_variable_sparse p var 2))
          L @
         map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) 1
               ((isolate_variable_sparse p var (Suc 0))\<^sup>2 -
                4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
               (2 * isolate_variable_sparse p var 2))
          F). freeIn var f" 
     using free_in_quad[OF freeA freeB1 freeC freeD]
       free_in_quad_fm[OF freeA freeB1 freeC freeD] by auto
   have quadratic2 : "\<forall>f\<in>set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1)
               ((isolate_variable_sparse p var (Suc 0))\<^sup>2 -
                4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
               (2 * isolate_variable_sparse p var 2))
          L @
         map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) (-1)
               ((isolate_variable_sparse p var (Suc 0))\<^sup>2 -
                4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
               (2 * isolate_variable_sparse p var 2))
          F). freeIn var f"
     using free_in_quad[OF freeA freeB2 freeC freeD]
       free_in_quad_fm[OF freeA freeB2 freeC freeD] by auto
   show ?thesis
     using not_in_mult not_in_add h4 not_in_pow not_in_sub freeIn_list_conj not_in_isovarspar hlinear quadratic1 quadratic2
-    bysimp
+    by simp
 qed
 
 
 text "Theorem 20.2 in the textbook"
 lemma elimVar_eq_2 :
   assumes hlength : "length xs = var"
   assumes in_list : "Eq p \<in> set(L)"
   assumes low_pow : "MPoly_Type.degree p var = 1 \<or> MPoly_Type.degree p var = 2"
   assumes nonzero : "\<forall>x. 
               insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 2) \<noteq> 0
             \<or> insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 1) \<noteq> 0
             \<or> insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 0) \<noteq> 0" (is ?non0)
   shows "(\<exists>x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # \<Gamma>)) =
          (\<exists>x. eval (elimVar var L F (Eq p)) (xs @ x # \<Gamma>))"
 proof-
   define A where "A = (isolate_variable_sparse p var 2)"
   define B where "B = (isolate_variable_sparse p var 1)"
   define C where "C = (isolate_variable_sparse p var 0)"
   have freeA : "var \<notin> vars A"
     unfolding A_def
     by (simp add: not_in_isovarspar)
   have freeB : "var \<notin> vars B"
     unfolding B_def
     by (simp add: not_in_isovarspar)
   have freeC : "var \<notin> vars C"
     unfolding C_def
     by (simp add: not_in_isovarspar)
   have express_p : "p = A*(Var var)^2+B*(Var var)+C"
     using express_poly[OF low_pow] unfolding A_def B_def C_def
     by fastforce
   have af : "isolate_variable_sparse p var 2 = A"
     using A_def by auto
   have bf : "isolate_variable_sparse p var (Suc 0) = B"
     using B_def by auto
   have cf : "isolate_variable_sparse p var 0 = C"
     using C_def by auto
   have xlength : "\<forall>x. (insertion (nth_default 0 (xs @ x # \<Gamma>)) (Var var))= x" 
     using hlength insertion_var
     by (metis add.commute add_strict_increasing length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl)
   fix x
   define c where "c i = (insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var i))" for i
   have c2 : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) A = c 2" 
     using freeA apply(simp add: A_def c_def)
     by (simp add: hlength insertion_lowerPoly1)
   have c1 : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) B = c 1"
     using freeB apply(simp add: B_def c_def)
     by (simp add: hlength insertion_lowerPoly1)
   have c0 : "\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) C = c 0"
     using freeC apply(simp add: C_def c_def)
     by (simp add: hlength insertion_lowerPoly1)
   have sum : "\<forall>x. c 2 * x\<^sup>2 + c (Suc 0) * x + c 0 = (\<Sum>i\<le>2. c i * x ^ i)"
     by (simp add: numerals(2))
   have "(\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>)) = (\<not>?non0)"
     apply(simp add : af bf cf)
     unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow xlength)
     apply(simp add:c2 c1 c0)
     apply(simp add: sum)
     using polyfun_eq_0[where c="c", where n="2"]
     using sum by auto
   then have "\<not>(\<forall>x. aEval (Eq p) (xs @ x \<Gamma>))"
     using nonzero by auto
   then show ?thesis
     using disjE[OF elimVar_eq[OF hlength in_list, where F="F", where \<Gamma>="\<Gamma>"], where R="?thesis"]
     using \<open>(\<forall>x. aEval (Eq p) (xs @ x # \<Gamma>)) = (\<not> (\<forall>x. insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 2) \<noteq> 0 \<or> insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 1) \<noteq> 0 \<or> insertion (nth_default 0 (xs @ x # \<Gamma>)) (isolate_variable_sparse p var 0) \<noteq> 0))\<close> low_pow nonzero by blast
 qed
 
 
 
 end
\ No newline at end of file