Theory Shadow_DOM

(***********************************************************************************
 * 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‹The Shadow DOM›
theory Shadow_DOM
  imports
    "monads/ShadowRootMonad"
    Core_DOM.Core_DOM
begin

abbreviation "safe_shadow_root_element_types ≡ {''article'', ''aside'', ''blockquote'', ''body'',
  ''div'', ''footer'', ''h1'', ''h2'', ''h3'', ''h4'', ''h5'', ''h6'', ''header'', ''main'',
  ''nav'', ''p'', ''section'', ''span''}"


subsection ‹Function Definitions›


subsubsection ‹get\_child\_nodes›

locale l_get_child_nodesShadow_DOM_defs =
  CD: l_get_child_nodesCore_DOM_defs
begin
definition get_child_nodesshadow_root_ptr :: "(_) shadow_root_ptr ⇒ unit
    ⇒ (_, (_) node_ptr list) dom_prog" where
  "get_child_nodesshadow_root_ptr shadow_root_ptr _ = get_M shadow_root_ptr RShadowRoot.child_nodes"

definition a_get_child_nodes_tups :: "(((_) object_ptr ⇒ bool) × ((_) object_ptr ⇒ unit
    ⇒ (_, (_) node_ptr list) dom_prog)) list" where
  "a_get_child_nodes_tups ≡ [(is_shadow_root_ptrobject_ptr, get_child_nodesshadow_root_ptr ∘ the ∘ cast)]"

definition a_get_child_nodes :: "(_) object_ptr ⇒ (_, (_) node_ptr list) dom_prog" where
  "a_get_child_nodes ptr = invoke (CD.a_get_child_nodes_tups @ a_get_child_nodes_tups) ptr ()"

definition a_get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" where
  "a_get_child_nodes_locs ptr ≡
    (if is_shadow_root_ptr_kind ptr
    then {preserved (get_M (the (cast ptr)) RShadowRoot.child_nodes)} else {}) ∪
    CD.a_get_child_nodes_locs ptr"

definition first_child :: "(_) object_ptr ⇒ (_, (_) node_ptr option) dom_prog"
  where
    "first_child ptr = do {
      children ← a_get_child_nodes ptr;
      return (case children of [] ⇒ None | child#_ ⇒ Some child)}"
end

global_interpretation l_get_child_nodesShadow_DOM_defs defines
  get_child_nodes = l_get_child_nodesShadow_DOM_defs.a_get_child_nodes and
  get_child_nodes_locs = l_get_child_nodesShadow_DOM_defs.a_get_child_nodes_locs
  .

locale l_get_child_nodesShadow_DOM =
  l_type_wf type_wf +
  l_known_ptr known_ptr +
  l_get_child_nodesShadow_DOM_defs +
  l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
  CD: l_get_child_nodesCore_DOM type_wfCore_DOM known_ptrCore_DOM get_child_nodesCore_DOM
  get_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ (_, (_) node_ptr list) dom_prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_child_nodesCore_DOM :: "(_) object_ptr ⇒ (_, (_) node_ptr list) dom_prog"
    and get_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes get_child_nodes_impl: "get_child_nodes = a_get_child_nodes"
  assumes get_child_nodes_locs_impl: "get_child_nodes_locs = a_get_child_nodes_locs"
begin
lemmas get_child_nodes_def = get_child_nodes_impl[unfolded a_get_child_nodes_def get_child_nodes_def]
lemmas get_child_nodes_locs_def = get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def
    get_child_nodes_locs_def, folded CD.get_child_nodes_locs_impl]

lemma get_child_nodes_ok:
  assumes "known_ptr ptr"
  assumes "type_wf h"
  assumes "ptr |∈| object_ptr_kinds h"
  shows "h ⊢ ok (get_child_nodes ptr)"
  using assms[unfolded known_ptr_impl type_wf_impl]
  apply(auto simp add: get_child_nodes_def)[1]
  apply(split CD.get_child_nodes_splits, rule conjI)+
  using ShadowRootClass.type_wfDocument CD.get_child_nodes_ok CD.known_ptr_impl CD.type_wf_impl
   apply blast
  apply(auto simp add: CD.known_ptr_impl a_get_child_nodes_tups_def get_child_nodesshadow_root_ptr_def
      get_MShadowRoot_ok
      dest!: known_ptr_new_shadow_root_ptr intro!: bind_is_OK_I2)[1]
  by (metis is_shadow_root_ptr_kind_none l_get_MShadowRoot_lemmas.get_MShadowRoot_ok
      l_get_MShadowRoot_lemmas_axioms option.case_eq_if shadow_root_ptr_casts_commute3
      shadow_root_ptr_kinds_commutes)

lemma get_child_nodes_ptr_in_heap:
  assumes "h ⊢ get_child_nodes ptr →r children"
  shows "ptr |∈| object_ptr_kinds h"
  using assms
  by(auto simp add: get_child_nodes_def invoke_ptr_in_heap dest: is_OK_returns_result_I)

lemma get_child_nodes_pure [simp]:
  "pure (get_child_nodes ptr) h"
  unfolding get_child_nodes_def a_get_child_nodes_tups_def
proof(split CD.get_child_nodes_splits, rule conjI; clarify)
  assume "known_ptrCore_DOM ptr"
  then show "pure (get_child_nodesCore_DOM ptr) h"
    by simp
next
  assume "¬ known_ptrCore_DOM ptr"
  then show "pure (invoke [(is_shadow_root_ptrobject_ptr,
       get_child_nodesshadow_root_ptr ∘ the ∘ castobject_ptr2shadow_root_ptr)]
     ptr ()) h"
    by(auto simp add: get_child_nodesshadow_root_ptr_def intro: bind_pure_I split: invoke_splits)
qed

lemma get_child_nodes_reads: "reads (get_child_nodes_locs ptr) (get_child_nodes ptr) h h'"
  apply (simp add: get_child_nodes_def a_get_child_nodes_tups_def get_child_nodes_locs_def
      CD.get_child_nodes_locs_def)
  apply(split CD.get_child_nodes_splits, rule conjI)+
   apply(auto intro!: reads_subset[OF CD.get_child_nodes_reads[unfolded CD.get_child_nodes_locs_def]]
      split: if_splits)[1]
  apply(split invoke_splits, rule conjI)+
   apply(auto)[1]
  apply(auto simp add: get_child_nodesshadow_root_ptr_def
      intro: reads_subset[OF reads_singleton] reads_subset[OF check_in_heap_reads]
      intro!: reads_bind_pure reads_subset[OF return_reads] split: option.splits)[1]
  done
end

interpretation i_get_child_nodes?: l_get_child_nodesShadow_DOM type_wf known_ptr DocumentClass.type_wf
  DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by(simp add: l_get_child_nodesShadow_DOM_def l_get_child_nodesShadow_DOM_axioms_def instances)
declare l_get_child_nodesShadow_DOM_axioms [instances]

lemma get_child_nodes_is_l_get_child_nodes [instances]: "l_get_child_nodes type_wf known_ptr
    get_child_nodes get_child_nodes_locs"
  apply(auto simp add: l_get_child_nodes_def instances)[1]
  using get_child_nodes_reads get_child_nodes_ok get_child_nodes_ptr_in_heap get_child_nodes_pure
  by blast+

paragraph ‹new\_document›

locale l_new_document_get_child_nodesShadow_DOM =
  CD: l_new_document_get_child_nodesCore_DOM type_wfCore_DOM known_ptrCore_DOM get_child_nodesCore_DOM
  get_child_nodes_locsCore_DOM
  + l_get_child_nodesShadow_DOM type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM get_child_nodes
  get_child_nodes_locs get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and get_child_nodesCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_child_nodes_new_document:
  "ptr' ≠ cast new_document_ptr ⟹ h ⊢ new_document →r new_document_ptr
  ⟹ h ⊢ new_document →h h' ⟹ r ∈ get_child_nodes_locs ptr' ⟹ r h h'"
  apply(auto simp add: get_child_nodes_locs_def)[1]
  using CD.get_child_nodes_new_document
   apply (metis document_ptr_casts_commute3 empty_iff is_document_ptr_kind_none
      new_document_get_MShadowRoot option.case_eq_if shadow_root_ptr_casts_commute3
      singletonD)
  by (simp add: CD.get_child_nodes_new_document)

lemma new_document_no_child_nodes:
  "h ⊢ new_document →r new_document_ptr ⟹ h ⊢ new_document →h h'
     ⟹ h' ⊢ get_child_nodes (cast new_document_ptr) →r []"
  apply(auto simp add: get_child_nodes_def)[1]
  apply(split CD.get_child_nodes_splits, rule conjI)+
  using CD.new_document_no_child_nodes apply auto[1]
  by(auto simp add: DocumentClass.a_known_ptr_def CD.known_ptr_impl known_ptr_def
      dest!: new_document_is_document_ptr)
end
interpretation i_new_document_get_child_nodes?:
  l_new_document_get_child_nodesShadow_DOM type_wf known_ptr get_child_nodes get_child_nodes_locs
  DocumentClass.type_wf DocumentClass.known_ptr Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by(unfold_locales)
declare l_new_document_get_child_nodesCore_DOM_axioms[instances]

lemma new_document_get_child_nodes_is_l_new_document_get_child_nodes [instances]:
  "l_new_document_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
  using new_document_is_l_new_document get_child_nodes_is_l_get_child_nodes
  apply(simp add: l_new_document_get_child_nodes_def l_new_document_get_child_nodes_axioms_def)
  using get_child_nodes_new_document new_document_no_child_nodes
  by fast

paragraph ‹new\_shadow\_root›

locale l_new_shadow_root_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM get_child_nodes
  get_child_nodes_locs get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and get_child_nodesCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_child_nodes_new_shadow_root:
  "ptr' ≠ cast new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →r new_shadow_root_ptr
     ⟹ h ⊢ newShadowRoot_M →h h' ⟹ r ∈ get_child_nodes_locs ptr' ⟹ r h h'"
  apply(auto simp add: get_child_nodes_locs_def)[1]
   apply (metis document_ptr_casts_commute3 insert_absorb insert_not_empty is_document_ptr_kind_none
      new_shadow_root_get_MShadowRoot option.case_eq_if shadow_root_ptr_casts_commute3 singletonD)
  apply(auto simp add: CD.get_child_nodes_locs_def)[1]
  using new_shadow_root_get_MObject apply blast
  apply (metis empty_iff insertE new_shadow_root_get_MElement)
  apply (metis empty_iff new_shadow_root_get_MDocument singletonD)
  done

lemma new_shadow_root_no_child_nodes:
  "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
     ⟹ h' ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []"
  apply(auto simp add: get_child_nodes_def )[1]
  apply(split CD.get_child_nodes_splits, rule conjI)+
   apply(auto simp add: CD.get_child_nodes_def CD.a_get_child_nodes_tups_def)[1]
   apply(split invoke_splits, rule conjI)+
  using NodeClass.a_known_ptr_def known_ptr_not_character_data_ptr known_ptr_not_document_ptr
    known_ptr_not_element_ptr local.CD.known_ptr_impl apply blast
     apply(auto simp add: is_document_ptr_def  split: option.splits document_ptr.splits)[1]
    apply(auto simp add: is_character_data_ptr_def  split: option.splits document_ptr.splits)[1]
   apply(auto simp add: is_element_ptr_def  split: option.splits document_ptr.splits)[1]
  apply(auto simp add: a_get_child_nodes_tups_def)[1]
  apply(split invoke_splits, rule conjI)+
   apply(auto simp add: is_shadow_root_ptr_def split: shadow_root_ptr.splits
      dest!: newShadowRoot_M_is_shadow_root_ptr)[1]
  apply(auto intro!: bind_pure_returns_result_I)[1]
   apply(drule(1) newShadowRoot_M_ptr_in_heap)
   apply(auto simp add: shadow_root_ptr_kinds_def document_ptr_kinds_def)[1]
   apply (metis check_in_heap_ptr_in_heap is_OK_returns_result_E old.unit.exhaust)
  using  new_shadow_root_children
  by (simp add: new_shadow_root_children get_child_nodesshadow_root_ptr_def)
end
interpretation i_new_shadow_root_get_child_nodes?:
  l_new_shadow_root_get_child_nodesShadow_DOM type_wf known_ptr get_child_nodes get_child_nodes_locs
  DocumentClass.type_wf DocumentClass.known_ptr Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by(unfold_locales)
declare l_new_shadow_root_get_child_nodesShadow_DOM_def[instances]

locale l_new_shadow_root_get_child_nodes = l_get_child_nodes +
  assumes get_child_nodes_new_shadow_root:
    "ptr' ≠ cast new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →r new_shadow_root_ptr
     ⟹ h ⊢ newShadowRoot_M →h h' ⟹ r ∈ get_child_nodes_locs ptr' ⟹ r h h'"
  assumes new_shadow_root_no_child_nodes:
    "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
     ⟹ h' ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []"

lemma new_shadow_root_get_child_nodes_is_l_new_shadow_root_get_child_nodes [instances]:
  "l_new_shadow_root_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
  apply(simp add: l_new_shadow_root_get_child_nodes_def l_new_shadow_root_get_child_nodes_axioms_def
      instances)
  using get_child_nodes_new_shadow_root new_shadow_root_no_child_nodes
  by fast

paragraph ‹new\_element›

locale l_new_element_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM +
  l_new_element_get_child_nodesCore_DOM type_wfCore_DOM known_ptrCore_DOM get_child_nodesCore_DOM
  get_child_nodes_locsCore_DOM
begin
lemma get_child_nodes_new_element:
  "ptr' ≠ cast new_element_ptr ⟹ h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
     ⟹ r ∈ get_child_nodes_locs ptr' ⟹ r h h'"
  by (auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def new_element_get_MObject
      new_element_get_MElement new_element_get_MDocument new_element_get_MShadowRoot
      split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E
      intro: is_element_ptr_kind_obtains)

lemma new_element_no_child_nodes:
  "h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
   ⟹ h' ⊢ get_child_nodes (cast new_element_ptr) →r []"
  apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def
      split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1]
  apply(split CD.get_child_nodes_splits, rule conjI)+
  using local.new_element_no_child_nodes apply auto[1]
  apply(auto simp add: invoke_def)[1]
  apply(auto simp add: new_element_ptr_in_heap get_child_nodeselement_ptr_def check_in_heap_def
      new_element_child_nodes intro!: bind_pure_returns_result_I
      intro: new_element_is_element_ptr elim!: new_element_ptr_in_heap)[1]
proof -
  assume " h ⊢ new_element →r new_element_ptr"
  assume "h ⊢ new_element →h h'"
  assume "¬ known_ptrCore_DOM (castelement_ptr2object_ptr new_element_ptr)"
  moreover
  have "known_ptr (cast new_element_ptr)"
    using new_element_is_element_ptr ‹h ⊢ new_element →r new_element_ptr›
    by(auto simp add: known_ptr_impl ShadowRootClass.a_known_ptr_def DocumentClass.a_known_ptr_def
        CharacterDataClass.a_known_ptr_def ElementClass.a_known_ptr_def)
  ultimately show "False"
    by(simp add: known_ptr_impl CD.known_ptr_impl ShadowRootClass.a_known_ptr_def
        is_document_ptr_kind_none)
qed
end

interpretation i_new_element_get_child_nodes?:
  l_new_element_get_child_nodesShadow_DOM type_wf known_ptr DocumentClass.type_wf
  DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by(unfold_locales)
declare l_new_element_get_child_nodesShadow_DOM_axioms[instances]

lemma new_element_get_child_nodes_is_l_new_element_get_child_nodes [instances]:
  "l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
  using new_element_is_l_new_element get_child_nodes_is_l_get_child_nodes
  apply(auto simp add: l_new_element_get_child_nodes_def l_new_element_get_child_nodes_axioms_def)[1]
  using get_child_nodes_new_element new_element_no_child_nodes
  by fast+




subsubsection ‹delete\_shadow\_root›

locale l_delete_shadow_root_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM
begin
lemma get_child_nodes_delete_shadow_root:
  "ptr' ≠ cast shadow_root_ptr ⟹ h ⊢ deleteShadowRoot_M shadow_root_ptr →h h' ⟹
    r ∈ get_child_nodes_locs ptr' ⟹ r h h'"
  by(auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def
      delete_shadow_root_get_MObject delete_shadow_root_get_MShadowRoot
      delete_shadow_root_get_MDocument delete_shadow_root_get_MElement
      split: if_splits option.splits
      intro: is_shadow_root_ptr_kind_obtains)
end

locale l_delete_shadow_root_get_child_nodes = l_get_child_nodes_defs +
  assumes get_child_nodes_delete_shadow_root:
    "ptr' ≠ cast shadow_root_ptr ⟹ h ⊢ deleteShadowRoot_M shadow_root_ptr →h h' ⟹
      r ∈ get_child_nodes_locs ptr' ⟹ r h h'"

interpretation l_delete_shadow_root_get_child_nodesShadow_DOM type_wf known_ptr DocumentClass.type_wf
  DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by(auto simp add: l_delete_shadow_root_get_child_nodesShadow_DOM_def instances)

lemma l_delete_shadow_root_get_child_nodes_get_child_nodes_locs [instances]: "l_delete_shadow_root_get_child_nodes get_child_nodes_locs"
  apply(auto simp add: l_delete_shadow_root_get_child_nodes_def)[1]
  using get_child_nodes_delete_shadow_root apply fast
  done



subsubsection ‹set\_child\_nodes›

locale l_set_child_nodesShadow_DOM_defs =
  CD: l_set_child_nodesCore_DOM_defs
begin
definition set_child_nodesshadow_root_ptr :: "(_) shadow_root_ptr ⇒ (_) node_ptr list
    ⇒ (_, unit) dom_prog" where
  "set_child_nodesshadow_root_ptr shadow_root_ptr = put_M shadow_root_ptr RShadowRoot.child_nodes_update"

definition a_set_child_nodes_tups :: "(((_) object_ptr ⇒ bool) × ((_) object_ptr ⇒ (_) node_ptr list
    ⇒ (_, unit) dom_prog)) list" where
  "a_set_child_nodes_tups ≡ [(is_shadow_root_ptrobject_ptr, set_child_nodesshadow_root_ptr ∘ the ∘ cast)]"

definition a_set_child_nodes :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ (_, unit) dom_prog" where
  "a_set_child_nodes ptr children = invoke (CD.a_set_child_nodes_tups @ a_set_child_nodes_tups)
    ptr children"

definition a_set_child_nodes_locs :: "(_) object_ptr ⇒ (_, unit) dom_prog set"
  where
    "a_set_child_nodes_locs ptr ≡
      (if is_shadow_root_ptr_kind ptr
      then all_args (put_M (the (cast ptr)) RShadowRoot.child_nodes_update)
      else {}) ∪ CD.a_set_child_nodes_locs ptr"
end

global_interpretation l_set_child_nodesShadow_DOM_defs defines
  set_child_nodes = l_set_child_nodesShadow_DOM_defs.a_set_child_nodes and
  set_child_nodes_locs = l_set_child_nodesShadow_DOM_defs.a_set_child_nodes_locs
  .

locale l_set_child_nodesShadow_DOM =
  l_type_wf type_wf +
  l_known_ptr known_ptr +
  l_set_child_nodesShadow_DOM_defs +
  l_set_child_nodes_defs set_child_nodes set_child_nodes_locs +
  CD: l_set_child_nodesCore_DOM type_wfCore_DOM known_ptrCore_DOM set_child_nodesCore_DOM
  set_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and set_child_nodes :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ (_, unit) dom_prog"
    and set_child_nodes_locs :: "(_) object_ptr ⇒ (_, unit) dom_prog set"
    and set_child_nodesCore_DOM :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ (_, unit) dom_prog"
    and set_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ (_, unit) dom_prog set" +
  assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes set_child_nodes_impl: "set_child_nodes = a_set_child_nodes"
  assumes set_child_nodes_locs_impl: "set_child_nodes_locs = a_set_child_nodes_locs"
begin
lemmas set_child_nodes_def = set_child_nodes_impl[unfolded a_set_child_nodes_def set_child_nodes_def]
lemmas set_child_nodes_locs_def = set_child_nodes_locs_impl[unfolded a_set_child_nodes_locs_def
    set_child_nodes_locs_def, folded CD.set_child_nodes_locs_impl]

lemma set_child_nodes_writes: "writes (set_child_nodes_locs ptr) (set_child_nodes ptr children) h h'"
  apply (simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes_locs_def)
  apply(split CD.set_child_nodes_splits, rule conjI)+
   apply (simp add: CD.set_child_nodes_writes writes_union_right_I)
  apply(split invoke_splits, rule conjI)+
   apply(auto simp add: a_set_child_nodes_def)[1]
  apply(auto simp add: set_child_nodesshadow_root_ptr_def
      intro!: writes_bind_pure
      intro: writes_union_right_I writes_union_left_I
      split: list.splits)[1]
  by (simp add: is_shadow_root_ptr_kind_none)

lemma set_child_nodes_pointers_preserved:
  assumes "w ∈ set_child_nodes_locs object_ptr"
  assumes "h ⊢ w →h h'"
  shows "object_ptr_kinds h = object_ptr_kinds h'"
  using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def set_child_nodes_locs_def CD.set_child_nodes_locs_def
      split: if_splits)

lemma set_child_nodes_types_preserved:
  assumes "w ∈ set_child_nodes_locs object_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def type_wf_impl a_set_child_nodes_tups_def set_child_nodes_locs_def
      CD.set_child_nodes_locs_def
      split: if_splits option.splits)
end

interpretation
  i_set_child_nodes?: l_set_child_nodesShadow_DOM type_wf known_ptr DocumentClass.type_wf
  DocumentClass.known_ptr set_child_nodes set_child_nodes_locs Core_DOM_Functions.set_child_nodes
  Core_DOM_Functions.set_child_nodes_locs
  apply(unfold_locales)
  by (auto simp add: set_child_nodes_def set_child_nodes_locs_def)
declare l_set_child_nodesShadow_DOM_axioms[instances]

lemma set_child_nodes_is_l_set_child_nodes [instances]: "l_set_child_nodes type_wf set_child_nodes
    set_child_nodes_locs"
  using instances Shadow_DOM.i_set_child_nodes.set_child_nodes_pointers_preserved Shadow_DOM.i_set_child_nodes.set_child_nodes_writes i_set_child_nodes.set_child_nodes_types_preserved
  unfolding l_set_child_nodes_def
  by blast


paragraph ‹get\_child\_nodes›

locale l_set_child_nodes_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM
  type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM get_child_nodes get_child_nodes_locs
  get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
  + l_set_child_nodesShadow_DOM
  type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM set_child_nodes set_child_nodes_locs
  set_child_nodesCore_DOM set_child_nodes_locsCore_DOM
  + CD: l_set_child_nodes_get_child_nodesCore_DOM
  type_wfCore_DOM known_ptrCore_DOM get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
  set_child_nodesCore_DOM set_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_child_nodesCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and set_child_nodes :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_child_nodesCore_DOM :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, unit) prog set"
begin

lemma set_child_nodes_get_child_nodes:
  assumes "known_ptr ptr"
  assumes "type_wf h"
  assumes "h ⊢ set_child_nodes ptr children →h h'"
  shows "h' ⊢ get_child_nodes ptr →r children"
proof -
  have "h ⊢ check_in_heap ptr →r ()"
    using assms set_child_nodes_def invoke_ptr_in_heap
    by (metis (full_types) check_in_heap_ptr_in_heap is_OK_returns_heap_I is_OK_returns_result_E
        old.unit.exhaust)
  then have ptr_in_h: "ptr |∈| object_ptr_kinds h"
    by (simp add: check_in_heap_ptr_in_heap is_OK_returns_result_I)

  have "type_wf h'"
    apply(unfold type_wf_impl)
    apply(rule subst[where P=id, OF type_wf_preserved[OF set_child_nodes_writes assms(3),
            unfolded all_args_def], simplified])
    by(auto simp add: all_args_def assms(2)[unfolded type_wf_impl] set_child_nodes_locs_def
        CD.set_child_nodes_locs_def
        split: if_splits)
  have "h' ⊢ check_in_heap ptr →r ()"
    using check_in_heap_reads set_child_nodes_writes assms(3) ‹h ⊢ check_in_heap ptr →r ()›
    apply(rule reads_writes_separate_forwards)
    apply(auto simp add: all_args_def set_child_nodes_locs_def CD.set_child_nodes_locs_def)[1]
    done
  then have "ptr |∈| object_ptr_kinds h'"
    using check_in_heap_ptr_in_heap by blast
  with assms ptr_in_h ‹type_wf h'› show ?thesis
    apply(auto simp add: type_wf_impl known_ptr_impl  get_child_nodes_def a_get_child_nodes_tups_def
        set_child_nodes_def a_set_child_nodes_tups_def
        del: bind_pure_returns_result_I2
        intro!: bind_pure_returns_result_I2)[1]
    apply(split CD.get_child_nodes_splits, (rule conjI impI)+)+
     apply(split CD.set_child_nodes_splits)+
      apply(auto simp add: CD.set_child_nodes_get_child_nodes type_wf_impl CD.type_wf_impl
        dest: ShadowRootClass.type_wfDocument)[1]
     apply(auto simp add: CD.set_child_nodes_get_child_nodes type_wf_impl CD.type_wf_impl
        dest: ShadowRootClass.type_wfDocument)[1]
    apply(split CD.set_child_nodes_splits)+
    by(auto simp add: known_ptr_impl CD.known_ptr_impl set_child_nodesshadow_root_ptr_def
        get_child_nodesshadow_root_ptr_def CD.type_wf_impl ShadowRootClass.type_wfDocument
        dest: known_ptr_new_shadow_root_ptr)[2]
qed

lemma set_child_nodes_get_child_nodes_different_pointers:
  assumes "ptr ≠ ptr'"
  assumes "w ∈ set_child_nodes_locs ptr"
  assumes "h ⊢ w →h h'"
  assumes "r ∈ get_child_nodes_locs ptr'"
  shows "r h h'"
  using assms
  apply(auto simp add: set_child_nodes_locs_def CD.set_child_nodes_locs_def
      get_child_nodes_locs_def CD.get_child_nodes_locs_def)[1]
  by(auto simp add: all_args_def
      elim!: is_document_ptr_kind_obtains is_shadow_root_ptr_kind_obtains
      is_element_ptr_kind_obtains
      split: if_splits option.splits)

end

interpretation
  i_set_child_nodes_get_child_nodes?: l_set_child_nodes_get_child_nodesShadow_DOM type_wf known_ptr
  DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes get_child_nodes_locs
  Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs set_child_nodes
  set_child_nodes_locs Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs
  using instances
  by(auto simp add: l_set_child_nodes_get_child_nodesShadow_DOM_def )
declare l_set_child_nodes_get_child_nodesShadow_DOM_axioms[instances]

lemma set_child_nodes_get_child_nodes_is_l_set_child_nodes_get_child_nodes [instances]:
  "l_set_child_nodes_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs
    set_child_nodes set_child_nodes_locs"
  apply(auto simp add: instances l_set_child_nodes_get_child_nodes_def
      l_set_child_nodes_get_child_nodes_axioms_def)[1]
  using set_child_nodes_get_child_nodes apply fast
  using set_child_nodes_get_child_nodes_different_pointers apply fast
  done

subsubsection ‹set\_tag\_type›

locale l_set_tag_nameShadow_DOM =
  CD: l_set_tag_nameCore_DOM type_wfCore_DOM set_tag_name set_tag_name_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and set_tag_name :: "(_) element_ptr ⇒ tag_name ⇒ (_, unit) dom_prog"
    and set_tag_name_locs :: "(_) element_ptr ⇒ (_, unit) dom_prog set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
begin
lemmas set_tag_name_def = CD.set_tag_name_impl[unfolded CD.a_set_tag_name_def set_tag_name_def]
lemmas set_tag_name_locs_def = CD.set_tag_name_locs_impl[unfolded CD.a_set_tag_name_locs_def
    set_tag_name_locs_def]

lemma set_tag_name_ok:
  "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹ h ⊢ ok (set_tag_name element_ptr tag)"
  apply(unfold type_wf_impl)
  unfolding set_tag_name_impl[unfolded a_set_tag_name_def] using get_MElement_ok put_MElement_ok
  using CD.set_tag_name_ok CD.type_wf_impl ShadowRootClass.type_wfDocument by blast

lemma set_tag_name_writes:
  "writes (set_tag_name_locs element_ptr) (set_tag_name element_ptr tag) h h'"
  using CD.set_tag_name_writes .

lemma set_tag_name_pointers_preserved:
  assumes "w ∈ set_tag_name_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "object_ptr_kinds h = object_ptr_kinds h'"
  using assms
  by(simp add: CD.set_tag_name_pointers_preserved)

lemma set_tag_name_typess_preserved:
  assumes "w ∈ set_tag_name_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  apply(unfold type_wf_impl)
  apply(rule type_wf_preserved[OF writes_singleton2 assms(2)])
  using assms(1) set_tag_name_locs_def
  by(auto simp add: all_args_def set_tag_name_locs_def
      split: if_splits)
end

interpretation i_set_tag_name?: l_set_tag_nameShadow_DOM type_wf DocumentClass.type_wf set_tag_name
  set_tag_name_locs
  by(auto simp add: l_set_tag_nameShadow_DOM_def l_set_tag_nameShadow_DOM_axioms_def instances)
declare l_set_tag_nameShadow_DOM_axioms [instances]

lemma set_tag_name_is_l_set_tag_name [instances]:
  "l_set_tag_name type_wf set_tag_name set_tag_name_locs"
  apply(auto simp add: l_set_tag_name_def)[1]
  using set_tag_name_writes apply fast
  using set_tag_name_ok apply fast
  using set_tag_name_pointers_preserved apply (fast, fast)
  using set_tag_name_typess_preserved apply (fast, fast)
  done

paragraph ‹get\_child\_nodes›

locale l_set_tag_name_get_child_nodesShadow_DOM =
  l_set_tag_nameShadow_DOM +
  l_get_child_nodesShadow_DOM +
  CD: l_set_tag_name_get_child_nodesCore_DOM type_wfCore_DOM set_tag_name set_tag_name_locs
  known_ptrCore_DOM get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
begin
lemma set_tag_name_get_child_nodes:
  "∀w ∈ set_tag_name_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"
  apply(auto simp add: get_child_nodes_locs_def)[1]
    apply(auto simp add: set_tag_name_locs_def all_args_def)[1]
  using CD.set_tag_name_get_child_nodes apply(blast)
  using CD.set_tag_name_get_child_nodes apply(blast)
  done
end

interpretation
  i_set_tag_name_get_child_nodes?: l_set_tag_name_get_child_nodesShadow_DOM type_wf
  DocumentClass.type_wf set_tag_name set_tag_name_locs known_ptr DocumentClass.known_ptr
  get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
  Core_DOM_Functions.get_child_nodes_locs
  by unfold_locales
declare l_set_tag_name_get_child_nodesShadow_DOM_axioms[instances]

lemma set_tag_name_get_child_nodes_is_l_set_tag_name_get_child_nodes [instances]:
  "l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr get_child_nodes
                                         get_child_nodes_locs"
  using set_tag_name_is_l_set_tag_name get_child_nodes_is_l_get_child_nodes
  apply(simp add: l_set_tag_name_get_child_nodes_def
      l_set_tag_name_get_child_nodes_axioms_def)
  using set_tag_name_get_child_nodes
  by fast



subsubsection ‹get\_shadow\_root›

locale l_get_shadow_rootShadow_DOM_defs
begin
definition a_get_shadow_root :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
  where
    "a_get_shadow_root element_ptr = get_M element_ptr shadow_root_opt"

definition a_get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  where
    "a_get_shadow_root_locs element_ptr ≡ {preserved (get_M element_ptr shadow_root_opt)}"
end

global_interpretation l_get_shadow_rootShadow_DOM_defs
  defines get_shadow_root = a_get_shadow_root
    and get_shadow_root_locs = a_get_shadow_root_locs
  .

locale l_get_shadow_root_defs =
  fixes get_shadow_root :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
  fixes get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM_defs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes get_shadow_root_impl: "get_shadow_root = a_get_shadow_root"
  assumes get_shadow_root_locs_impl: "get_shadow_root_locs = a_get_shadow_root_locs"
begin
lemmas get_shadow_root_def = get_shadow_root_impl[unfolded get_shadow_root_def a_get_shadow_root_def]
lemmas get_shadow_root_locs_def = get_shadow_root_locs_impl[unfolded get_shadow_root_locs_def
    a_get_shadow_root_locs_def]

lemma get_shadow_root_ok:
  "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹ h ⊢ ok (get_shadow_root element_ptr)"
  unfolding get_shadow_root_def type_wf_impl
  using ShadowRootMonad.get_MElement_ok by blast

lemma get_shadow_root_pure [simp]: "pure (get_shadow_root element_ptr) h"
  unfolding get_shadow_root_def by simp

lemma get_shadow_root_ptr_in_heap:
  assumes "h ⊢ get_shadow_root element_ptr →r children"
  shows "element_ptr |∈| element_ptr_kinds h"
  using assms
  by(auto simp add: get_shadow_root_def get_MElement_ptr_in_heap dest: is_OK_returns_result_I)

lemma get_shadow_root_reads:
  "reads (get_shadow_root_locs element_ptr) (get_shadow_root element_ptr) h h'"
  by(simp add: get_shadow_root_def get_shadow_root_locs_def reads_bind_pure
      reads_insert_writes_set_right)
end

interpretation i_get_shadow_root?: l_get_shadow_rootShadow_DOM type_wf get_shadow_root
  get_shadow_root_locs
  using instances
  by (auto simp add: l_get_shadow_rootShadow_DOM_def)
declare l_get_shadow_rootShadow_DOM_axioms [instances]

locale l_get_shadow_root = l_type_wf + l_get_shadow_root_defs +
  assumes get_shadow_root_reads:
    "reads (get_shadow_root_locs element_ptr) (get_shadow_root element_ptr) h h'"
  assumes get_shadow_root_ok:
    "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹ h ⊢ ok (get_shadow_root element_ptr)"
  assumes get_shadow_root_ptr_in_heap:
    "h ⊢ ok (get_shadow_root element_ptr) ⟹ element_ptr |∈| element_ptr_kinds h"
  assumes get_shadow_root_pure [simp]:
    "pure (get_shadow_root element_ptr) h"

lemma get_shadow_root_is_l_get_shadow_root [instances]:
  "l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
  using instances
  unfolding l_get_shadow_root_def
  by (metis (no_types, lifting) ElementClass.l_type_wfElement_axioms get_shadow_root_ok get_shadow_root_pure get_shadow_root_reads l_get_MElement_lemmas.get_MElement_ptr_in_heap l_get_MElement_lemmas.intro l_get_shadow_rootShadow_DOM.get_shadow_root_def)


paragraph ‹set\_disconnected\_nodes›

locale l_set_disconnected_nodes_get_shadow_rootShadow_DOM =
  l_set_disconnected_nodesCore_DOM type_wfCore_DOM set_disconnected_nodes set_disconnected_nodes_locs +
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and set_disconnected_nodes
    :: "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma set_disconnected_nodes_get_shadow_root:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: set_disconnected_nodes_locs_def get_shadow_root_locs_def all_args_def)
end

locale l_set_disconnected_nodes_get_shadow_root =
  l_set_disconnected_nodes_defs +
  l_get_shadow_root_defs +
  assumes set_disconnected_nodes_get_shadow_root:
    "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

interpretation
  i_set_disconnected_nodes_get_shadow_root?: l_set_disconnected_nodes_get_shadow_rootShadow_DOM
  type_wf DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_shadow_root
  get_shadow_root_locs
  by(auto simp add: l_set_disconnected_nodes_get_shadow_rootShadow_DOM_def instances)
declare l_set_disconnected_nodes_get_shadow_rootShadow_DOM_axioms[instances]

lemma set_disconnected_nodes_get_shadow_root_is_l_set_disconnected_nodes_get_shadow_root [instances]:
  "l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes_locs get_shadow_root_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_shadow_root_def)[1]
  using set_disconnected_nodes_get_shadow_root apply fast
  done

paragraph ‹set\_tag\_type›

locale l_set_tag_name_get_shadow_rootCore_DOM =
  l_set_tag_nameShadow_DOM +
  l_get_shadow_rootShadow_DOM
begin
lemma set_tag_name_get_shadow_root:
  "∀w ∈ set_tag_name_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: set_tag_name_locs_def
      get_shadow_root_locs_def all_args_def
      intro: element_put_get_preserved[where setter=tag_name_update and getter=shadow_root_opt])
end

locale l_set_tag_name_get_shadow_root = l_set_tag_name + l_get_shadow_root +
  assumes set_tag_name_get_shadow_root:
    "∀w ∈ set_tag_name_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

interpretation
  i_set_tag_name_get_shadow_root?: l_set_tag_name_get_shadow_rootCore_DOM type_wf DocumentClass.type_wf
  set_tag_name set_tag_name_locs
  get_shadow_root get_shadow_root_locs
  apply(auto simp add: l_set_tag_name_get_shadow_rootCore_DOM_def instances)[1]
  using l_set_tag_nameShadow_DOM_axioms
  by unfold_locales
declare l_set_tag_name_get_shadow_rootCore_DOM_axioms[instances]

lemma set_tag_name_get_shadow_root_is_l_set_tag_name_get_shadow_root [instances]:
  "l_set_tag_name_get_shadow_root type_wf set_tag_name set_tag_name_locs get_shadow_root
                                  get_shadow_root_locs"
  using set_tag_name_is_l_set_tag_name get_shadow_root_is_l_get_shadow_root
  apply(simp add: l_set_tag_name_get_shadow_root_def l_set_tag_name_get_shadow_root_axioms_def)
  using set_tag_name_get_shadow_root
  by fast


paragraph ‹set\_child\_nodes›

locale l_set_child_nodes_get_shadow_rootShadow_DOM =
  l_set_child_nodesShadow_DOM type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM set_child_nodes
  set_child_nodes_locs set_child_nodesCore_DOM set_child_nodes_locsCore_DOM +
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and set_child_nodes :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_child_nodesCore_DOM :: "(_) object_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, unit) prog set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma set_child_nodes_get_shadow_root: "∀w ∈ set_child_nodes_locs ptr. (h ⊢ w →h h' ⟶
  (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  apply(auto simp add: set_child_nodes_locs_def get_shadow_root_locs_def CD.set_child_nodes_locs_def
      all_args_def)[1]
  by(auto intro!: element_put_get_preserved[where getter=shadow_root_opt and
        setter=RElement.child_nodes_update])
end

locale l_set_child_nodes_get_shadow_root = l_set_child_nodes_defs + l_get_shadow_root_defs +
  assumes set_child_nodes_get_shadow_root:
    "∀w ∈ set_child_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

interpretation
  i_set_child_nodes_get_shadow_root?: l_set_child_nodes_get_shadow_rootShadow_DOM type_wf known_ptr
  DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
  Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_shadow_root
  get_shadow_root_locs
  by(auto simp add: l_set_child_nodes_get_shadow_rootShadow_DOM_def instances)
declare l_set_child_nodes_get_shadow_rootShadow_DOM_axioms[instances]

lemma set_child_nodes_get_shadow_root_is_l_set_child_nodes_get_shadow_root [instances]:
  "l_set_child_nodes_get_shadow_root set_child_nodes_locs get_shadow_root_locs"
  apply(auto simp add: l_set_child_nodes_get_shadow_root_def)[1]
  using set_child_nodes_get_shadow_root apply fast
  done


paragraph ‹delete\_shadow\_root›

locale l_delete_shadow_root_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM
begin
lemma get_shadow_root_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  by(auto simp add: get_shadow_root_locs_def delete_shadow_root_get_MElement)
end

locale l_delete_shadow_root_get_shadow_root = l_get_shadow_root_defs +
  assumes get_shadow_root_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
interpretation l_delete_shadow_root_get_shadow_rootShadow_DOM type_wf get_shadow_root
  get_shadow_root_locs
  by(auto simp add: l_delete_shadow_root_get_shadow_rootShadow_DOM_def instances)

lemma l_delete_shadow_root_get_shadow_root_get_shadow_root_locs [instances]: "l_delete_shadow_root_get_shadow_root get_shadow_root_locs"
  apply(auto simp add: l_delete_shadow_root_get_shadow_root_def)[1]
  using get_shadow_root_delete_shadow_root apply fast
  done

paragraph ‹new\_character\_data›

locale l_new_character_data_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_shadow_root_new_character_data:
  "h ⊢ new_character_data →r new_character_data_ptr ⟹ h ⊢ new_character_data →h h'
     ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  by (auto simp add: get_shadow_root_locs_def new_character_data_get_MObject
      new_character_data_get_MElement
      split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E
      intro: is_element_ptr_kind_obtains)
end

locale l_new_character_data_get_shadow_root = l_new_character_data + l_get_shadow_root +
  assumes get_shadow_root_new_character_data:
    "h ⊢ new_character_data →r new_character_data_ptr
            ⟹ h ⊢ new_character_data →h h' ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"


interpretation i_new_character_data_get_shadow_root?:
  l_new_character_data_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  by(unfold_locales)
declare l_new_character_data_get_shadow_rootShadow_DOM_axioms [instances]

lemma new_character_data_get_shadow_root_is_l_new_character_data_get_shadow_root [instances]:
  "l_new_character_data_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
  using new_character_data_is_l_new_character_data get_shadow_root_is_l_get_shadow_root
  apply(auto simp add: l_new_character_data_get_shadow_root_def
      l_new_character_data_get_shadow_root_axioms_def instances)[1]
  using get_shadow_root_new_character_data
  by fast

paragraph ‹new\_document›

locale l_new_document_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_shadow_root_new_document:
  "h ⊢ new_document →r new_document_ptr ⟹ h ⊢ new_document →h h'
     ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  by (auto simp add: get_shadow_root_locs_def new_document_get_MObject new_document_get_MElement
      split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
end

locale l_new_document_get_shadow_root = l_new_document + l_get_shadow_root +
  assumes get_shadow_root_new_document:
    "h ⊢ new_document →r new_document_ptr
            ⟹ h ⊢ new_document →h h' ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"


interpretation i_new_document_get_shadow_root?:
  l_new_document_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  by(unfold_locales)
declare l_new_document_get_shadow_rootShadow_DOM_axioms [instances]

lemma new_document_get_shadow_root_is_l_new_document_get_shadow_root [instances]:
  "l_new_document_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
  using new_document_is_l_new_document get_shadow_root_is_l_get_shadow_root
  apply(auto simp add: l_new_document_get_shadow_root_def l_new_document_get_shadow_root_axioms_def
      instances)[1]
  using get_shadow_root_new_document
  by fast

paragraph ‹new\_element›

locale l_new_element_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_shadow_root_new_element:
  "ptr' ≠ new_element_ptr ⟹ h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
     ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  by (auto simp add: get_shadow_root_locs_def new_element_get_MObject new_element_get_MElement
      new_element_get_MDocument split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)

lemma new_element_no_shadow_root:
  "h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
   ⟹ h' ⊢ get_shadow_root new_element_ptr →r None"
  by(simp add: get_shadow_root_def new_element_shadow_root_opt)
end

locale l_new_element_get_shadow_root = l_new_element + l_get_shadow_root +
  assumes get_shadow_root_new_element:
    "ptr' ≠ new_element_ptr ⟹ h ⊢ new_element →r new_element_ptr
            ⟹ h ⊢ new_element →h h' ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  assumes new_element_no_shadow_root:
    "h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
            ⟹ h' ⊢ get_shadow_root new_element_ptr →r None"


interpretation i_new_element_get_shadow_root?:
  l_new_element_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  by(unfold_locales)
declare l_new_element_get_shadow_rootShadow_DOM_axioms [instances]

lemma new_element_get_shadow_root_is_l_new_element_get_shadow_root [instances]:
  "l_new_element_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
  using new_element_is_l_new_element get_shadow_root_is_l_get_shadow_root
  apply(auto simp add: l_new_element_get_shadow_root_def l_new_element_get_shadow_root_axioms_def
      instances)[1]
  using get_shadow_root_new_element new_element_no_shadow_root
  by fast+

paragraph ‹new\_shadow\_root›

locale l_new_shadow_root_get_shadow_rootShadow_DOM =
  l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_shadow_root_new_shadow_root:
  "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
     ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"
  by (auto simp add: get_shadow_root_locs_def new_shadow_root_get_MObject new_shadow_root_get_MElement
      split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
end

locale l_new_shadow_root_get_shadow_root = l_get_shadow_root +
  assumes get_shadow_root_new_shadow_root:
    "h ⊢ newShadowRoot_M →r new_shadow_root_ptr
            ⟹ h ⊢ newShadowRoot_M →h h' ⟹ r ∈ get_shadow_root_locs ptr' ⟹ r h h'"

interpretation i_new_shadow_root_get_shadow_root?:
  l_new_shadow_root_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  by(unfold_locales)
declare l_new_shadow_root_get_shadow_rootShadow_DOM_axioms [instances]

lemma new_shadow_root_get_shadow_root_is_l_new_shadow_root_get_shadow_root [instances]:
  "l_new_shadow_root_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
  using get_shadow_root_is_l_get_shadow_root
  apply(auto simp add: l_new_shadow_root_get_shadow_root_def
      l_new_shadow_root_get_shadow_root_axioms_def instances)[1]
  using get_shadow_root_new_shadow_root
  by fast


subsubsection ‹set\_shadow\_root›

locale l_set_shadow_rootShadow_DOM_defs
begin
definition a_set_shadow_root :: "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ (_, unit) dom_prog"
  where
    "a_set_shadow_root element_ptr = put_M element_ptr shadow_root_opt_update"

definition a_set_shadow_root_locs :: "(_) element_ptr ⇒ ((_, unit) dom_prog) set"
  where
    "a_set_shadow_root_locs element_ptr ≡ all_args (put_M element_ptr shadow_root_opt_update)"
end

global_interpretation l_set_shadow_rootShadow_DOM_defs
  defines set_shadow_root = a_set_shadow_root
    and set_shadow_root_locs = a_set_shadow_root_locs
  .

locale l_set_shadow_root_defs =
  fixes set_shadow_root :: "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ (_, unit) dom_prog"
  fixes set_shadow_root_locs :: "(_) element_ptr ⇒ (_, unit) dom_prog set"


locale l_set_shadow_rootShadow_DOM =
  l_type_wf type_wf +
  l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
  l_set_shadow_rootShadow_DOM_defs
  for type_wf :: "(_) heap ⇒ bool"
    and set_shadow_root :: "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ (_, unit) dom_prog"
    and set_shadow_root_locs :: "(_) element_ptr ⇒ (_, unit) dom_prog set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes set_shadow_root_impl: "set_shadow_root = a_set_shadow_root"
  assumes set_shadow_root_locs_impl: "set_shadow_root_locs = a_set_shadow_root_locs"
begin
lemmas set_shadow_root_def = set_shadow_root_impl[unfolded set_shadow_root_def
    a_set_shadow_root_def]
lemmas set_shadow_root_locs_def = set_shadow_root_locs_impl[unfolded set_shadow_root_locs_def
    a_set_shadow_root_locs_def]

lemma set_shadow_root_ok: "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹
  h ⊢ ok (set_shadow_root element_ptr tag)"
  apply(unfold type_wf_impl)
  unfolding set_shadow_root_def using get_MElement_ok put_MElement_ok
  by (simp add: ShadowRootMonad.put_MElement_ok)

lemma set_shadow_root_ptr_in_heap:
  "h ⊢ ok (set_shadow_root element_ptr shadow_root) ⟹ element_ptr |∈| element_ptr_kinds h"
  by(simp add: set_shadow_root_def ElementMonad.put_M_ptr_in_heap)

lemma set_shadow_root_writes:
  "writes (set_shadow_root_locs element_ptr) (set_shadow_root element_ptr tag) h h'"
  by(auto simp add: set_shadow_root_def set_shadow_root_locs_def intro: writes_bind_pure)

lemma set_shadow_root_pointers_preserved:
  assumes "w ∈ set_shadow_root_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "object_ptr_kinds h = object_ptr_kinds h'"
  using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def set_shadow_root_locs_def split: if_splits)

lemma set_shadow_root_types_preserved:
  assumes "w ∈ set_shadow_root_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  apply(unfold type_wf_impl)
  using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def set_shadow_root_locs_def split: if_splits)
end

interpretation i_set_shadow_root?: l_set_shadow_rootShadow_DOM type_wf set_shadow_root
  set_shadow_root_locs
  by (auto simp add: l_set_shadow_rootShadow_DOM_def instances)
declare l_set_shadow_rootShadow_DOM_axioms [instances]

locale l_set_shadow_root = l_type_wf +l_set_shadow_root_defs +
  assumes set_shadow_root_writes:
    "writes (set_shadow_root_locs element_ptr) (set_shadow_root element_ptr disc_nodes) h h'"
  assumes set_shadow_root_ok:
    "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹
      h ⊢ ok (set_shadow_root element_ptr shadow_root)"
  assumes set_shadow_root_ptr_in_heap:
    "h ⊢ ok (set_shadow_root element_ptr shadow_root) ⟹ element_ptr |∈| element_ptr_kinds h"
  assumes set_shadow_root_pointers_preserved:
    "w ∈ set_shadow_root_locs element_ptr ⟹ h ⊢ w →h h' ⟹
      object_ptr_kinds h = object_ptr_kinds h'"
  assumes set_shadow_root_types_preserved:
    "w ∈ set_shadow_root_locs element_ptr ⟹ h ⊢ w →h h' ⟹ type_wf h = type_wf h'"

lemma set_shadow_root_is_l_set_shadow_root [instances]:
  "l_set_shadow_root type_wf set_shadow_root set_shadow_root_locs"
  apply(auto simp add: l_set_shadow_root_def instances)[1]
  using set_shadow_root_writes apply blast
  using set_shadow_root_ok apply (blast)
  using set_shadow_root_ptr_in_heap apply blast
  using set_shadow_root_pointers_preserved apply(blast, blast)
  using set_shadow_root_types_preserved apply(blast, blast)
  done

paragraph ‹get\_shadow\_root›

locale l_set_shadow_root_get_shadow_rootShadow_DOM =
  l_set_shadow_rootShadow_DOM +
  l_get_shadow_rootShadow_DOM
begin
lemma set_shadow_root_get_shadow_root:
  "type_wf h ⟹ h ⊢ set_shadow_root ptr shadow_root_ptr_opt →h h' ⟹
  h' ⊢ get_shadow_root ptr →r shadow_root_ptr_opt"
  by(auto simp add: set_shadow_root_def get_shadow_root_def)

lemma set_shadow_root_get_shadow_root_different_pointers: "ptr ≠ ptr' ⟹
  ∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: set_shadow_root_locs_def get_shadow_root_locs_def all_args_def)
end

interpretation i_set_shadow_root_get_shadow_root?: l_set_shadow_root_get_shadow_rootShadow_DOM type_wf
  set_shadow_root set_shadow_root_locs get_shadow_root get_shadow_root_locs
  apply(auto simp add: l_set_shadow_root_get_shadow_rootShadow_DOM_def instances)[1]
  by(unfold_locales)
declare l_set_shadow_root_get_shadow_rootShadow_DOM_axioms[instances]

locale l_set_shadow_root_get_shadow_root =
  l_type_wf +
  l_set_shadow_root_defs +
  l_get_shadow_root_defs +
  assumes set_shadow_root_get_shadow_root:
    "type_wf h ⟹ h ⊢ set_shadow_root ptr shadow_root_ptr_opt →h h' ⟹
      h' ⊢ get_shadow_root ptr →r shadow_root_ptr_opt"
  assumes set_shadow_root_get_shadow_root_different_pointers:
    "ptr ≠ ptr' ⟹ w ∈ set_shadow_root_locs ptr ⟹ h ⊢ w →h h' ⟹
      r ∈ get_shadow_root_locs ptr' ⟹ r h h'"

lemma set_shadow_root_get_shadow_root_is_l_set_shadow_root_get_shadow_root [instances]:
  "l_set_shadow_root_get_shadow_root type_wf set_shadow_root set_shadow_root_locs get_shadow_root
  get_shadow_root_locs"
  apply(auto simp add: l_set_shadow_root_get_shadow_root_def instances)[1]
  using set_shadow_root_get_shadow_root apply fast
  using set_shadow_root_get_shadow_root_different_pointers apply fast
  done



subsubsection ‹set\_mode›

locale l_set_modeShadow_DOM_defs
begin
definition a_set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ (_, unit) dom_prog"
  where
    "a_set_mode shadow_root_ptr = put_M shadow_root_ptr mode_update"

definition a_set_mode_locs :: "(_) shadow_root_ptr ⇒ ((_, unit) dom_prog) set"
  where
    "a_set_mode_locs shadow_root_ptr ≡ all_args (put_M shadow_root_ptr mode_update)"
end

global_interpretation l_set_modeShadow_DOM_defs
  defines set_mode = a_set_mode
    and set_mode_locs = a_set_mode_locs
  .

locale l_set_mode_defs =
  fixes set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ (_, unit) dom_prog"
  fixes set_mode_locs :: "(_) shadow_root_ptr ⇒ (_, unit) dom_prog set"


locale l_set_modeShadow_DOM =
  l_type_wf type_wf +
  l_set_mode_defs set_mode set_mode_locs +
  l_set_modeShadow_DOM_defs
  for type_wf :: "(_) heap ⇒ bool"
    and set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ (_, unit) dom_prog"
    and set_mode_locs :: "(_) shadow_root_ptr ⇒ (_, unit) dom_prog set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes set_mode_impl: "set_mode = a_set_mode"
  assumes set_mode_locs_impl: "set_mode_locs = a_set_mode_locs"
begin
lemmas set_mode_def = set_mode_impl[unfolded set_mode_def a_set_mode_def]
lemmas set_mode_locs_def = set_mode_locs_impl[unfolded set_mode_locs_def a_set_mode_locs_def]

lemma set_mode_ok:
  "type_wf h ⟹ shadow_root_ptr |∈| shadow_root_ptr_kinds h ⟹
    h ⊢ ok (set_mode shadow_root_ptr shadow_root_mode)"
  apply(unfold type_wf_impl)
  unfolding set_mode_def using get_MShadowRoot_ok put_MShadowRoot_ok
  by (simp add: ShadowRootMonad.put_MShadowRoot_ok)

lemma set_mode_ptr_in_heap:
  "h ⊢ ok (set_mode shadow_root_ptr shadow_root_mode) ⟹
    shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  by(simp add: set_mode_def put_M_ptr_in_heap)

lemma set_mode_writes:
  "writes (set_mode_locs shadow_root_ptr) (set_mode shadow_root_ptr shadow_root_mode) h h'"
  by(auto simp add: set_mode_def set_mode_locs_def intro: writes_bind_pure)

lemma set_mode_pointers_preserved:
  assumes "w ∈ set_mode_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "object_ptr_kinds h = object_ptr_kinds h'"
  using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def set_mode_locs_def split: if_splits)

lemma set_mode_types_preserved:
  assumes "w ∈ set_mode_locs element_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  apply(unfold type_wf_impl)
  using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def set_mode_locs_def split: if_splits)
end

interpretation i_set_mode?: l_set_modeShadow_DOM type_wf set_mode set_mode_locs
  by (auto simp add: l_set_modeShadow_DOM_def instances)
declare l_set_modeShadow_DOM_axioms [instances]

locale l_set_mode = l_type_wf +l_set_mode_defs +
  assumes set_mode_writes:
    "writes (set_mode_locs shadow_root_ptr) (set_mode shadow_root_ptr shadow_root_mode) h h'"
  assumes set_mode_ok:
    "type_wf h ⟹ shadow_root_ptr |∈| shadow_root_ptr_kinds h ⟹
      h ⊢ ok (set_mode shadow_root_ptr shadow_root_mode)"
  assumes set_mode_ptr_in_heap:
    "h ⊢ ok (set_mode shadow_root_ptr shadow_root_mode) ⟹
      shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  assumes set_mode_pointers_preserved:
    "w ∈ set_mode_locs shadow_root_ptr ⟹
      h ⊢ w →h h' ⟹ object_ptr_kinds h = object_ptr_kinds h'"
  assumes set_mode_types_preserved:
    "w ∈ set_mode_locs shadow_root_ptr ⟹ h ⊢ w →h h' ⟹ type_wf h = type_wf h'"

lemma set_mode_is_l_set_mode [instances]: "l_set_mode type_wf set_mode set_mode_locs"
  apply(auto simp add: l_set_mode_def instances)[1]
  using set_mode_writes apply blast
  using set_mode_ok apply (blast)
  using set_mode_ptr_in_heap apply blast
  using set_mode_pointers_preserved apply(blast, blast)
  using set_mode_types_preserved apply(blast, blast)
  done


paragraph ‹get\_child\_nodes›

locale l_set_shadow_root_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM +
  l_set_shadow_rootShadow_DOM
begin
lemma set_shadow_root_get_child_nodes:
  "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"
  by(auto simp add: get_child_nodes_locs_def set_shadow_root_locs_def CD.get_child_nodes_locs_def
      all_args_def
      intro: element_put_get_preserved[where setter=shadow_root_opt_update])
end

interpretation i_set_shadow_root_get_child_nodes?: l_set_shadow_root_get_child_nodesShadow_DOM type_wf
  known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes get_child_nodes_locs
  Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs set_shadow_root
  set_shadow_root_locs
  by(unfold_locales)
declare l_set_shadow_root_get_child_nodesShadow_DOM_axioms[instances]

locale l_set_shadow_root_get_child_nodes = l_set_shadow_root + l_get_child_nodes +
  assumes set_shadow_root_get_child_nodes:
    "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"

lemma set_shadow_root_get_child_nodes_is_l_set_shadow_root_get_child_nodes [instances]:
  "l_set_shadow_root_get_child_nodes type_wf set_shadow_root set_shadow_root_locs known_ptr
    get_child_nodes get_child_nodes_locs"
  apply(auto simp add: l_set_shadow_root_get_child_nodes_def
      l_set_shadow_root_get_child_nodes_axioms_def instances)[1]
  using set_shadow_root_get_child_nodes apply blast
  done

paragraph ‹get\_shadow\_root›


locale l_set_mode_get_shadow_rootShadow_DOM =
  l_set_modeShadow_DOM +
  l_get_shadow_rootShadow_DOM
begin
lemma set_mode_get_shadow_root:
  "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: set_mode_locs_def get_shadow_root_locs_def all_args_def)
end

interpretation
  i_set_mode_get_shadow_root?: l_set_mode_get_shadow_rootShadow_DOM type_wf
  set_mode set_mode_locs get_shadow_root
  get_shadow_root_locs
  by unfold_locales
declare l_set_mode_get_shadow_rootShadow_DOM_axioms[instances]

locale l_set_mode_get_shadow_root = l_set_mode + l_get_shadow_root +
  assumes set_mode_get_shadow_root:
    "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

lemma set_mode_get_shadow_root_is_l_set_mode_get_shadow_root [instances]:
  "l_set_mode_get_shadow_root type_wf set_mode set_mode_locs get_shadow_root
                                         get_shadow_root_locs"
  using set_mode_is_l_set_mode get_shadow_root_is_l_get_shadow_root
  apply(simp add: l_set_mode_get_shadow_root_def
      l_set_mode_get_shadow_root_axioms_def)
  using set_mode_get_shadow_root
  by fast

paragraph ‹get\_child\_nodes›

locale l_set_mode_get_child_nodesShadow_DOM =
  l_set_modeShadow_DOM +
  l_get_child_nodesShadow_DOM
begin
lemma set_mode_get_child_nodes:
  "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"
  by(auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def set_mode_locs_def
      all_args_def)[1]
end

interpretation i_set_mode_get_child_nodes?: l_set_mode_get_child_nodesShadow_DOM type_wf set_mode
  set_mode_locs known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
  get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
  by unfold_locales
declare l_set_mode_get_child_nodesShadow_DOM_axioms[instances]

locale l_set_mode_get_child_nodes = l_set_mode + l_get_child_nodes +
  assumes set_mode_get_child_nodes:
    "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"

lemma set_mode_get_child_nodes_is_l_set_mode_get_child_nodes [instances]:
  "l_set_mode_get_child_nodes type_wf set_mode set_mode_locs known_ptr get_child_nodes
                                         get_child_nodes_locs"
  using set_mode_is_l_set_mode get_child_nodes_is_l_get_child_nodes
  apply(simp add: l_set_mode_get_child_nodes_def
      l_set_mode_get_child_nodes_axioms_def)
  using set_mode_get_child_nodes
  by fast


subsubsection ‹get\_host›

locale l_get_hostShadow_DOM_defs =
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
  for get_shadow_root
    :: "(_::linorder) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_get_host :: "(_) shadow_root_ptr ⇒ (_, (_) element_ptr) dom_prog"  where
  "a_get_host shadow_root_ptr = do {
      host_ptrs ← element_ptr_kinds_M ⤜ filter_M (λelement_ptr. do {
        shadow_root_opt ← get_shadow_root element_ptr;
        return (shadow_root_opt = Some shadow_root_ptr)
      });
      (case host_ptrs of host_ptr#[] ⇒ return host_ptr | _ ⇒ error HierarchyRequestError)
    }"
definition "a_get_host_locs ≡ (⋃element_ptr. (get_shadow_root_locs element_ptr)) ∪
  (⋃ptr. {preserved (get_MObject ptr RObject.nothing)})"

end

global_interpretation l_get_hostShadow_DOM_defs get_shadow_root get_shadow_root_locs
  defines get_host = "a_get_host"
    and get_host_locs = "a_get_host_locs"
  .

locale l_get_host_defs =
  fixes get_host :: "(_) shadow_root_ptr ⇒ (_, (_) element_ptr) dom_prog"
  fixes get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_hostShadow_DOM =
  l_get_hostShadow_DOM_defs +
  l_get_host_defs +
  l_get_shadow_root +
  assumes get_host_impl: "get_host = a_get_host"
  assumes get_host_locs_impl: "get_host_locs = a_get_host_locs"
begin
lemmas get_host_def = get_host_impl[unfolded a_get_host_def]
lemmas get_host_locs_def = get_host_locs_impl[unfolded a_get_host_locs_def]

lemma get_host_pure [simp]: "pure (get_host element_ptr) h"
  by(auto simp add: get_host_def intro!: bind_pure_I filter_M_pure_I split: list.splits)

lemma get_host_reads: "reads get_host_locs (get_host element_ptr) h h'"
  using get_shadow_root_reads[unfolded reads_def]
  by(auto simp add: get_host_def get_host_locs_def
      intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] reads_subset[OF error_reads]
      reads_subset[OF get_shadow_root_reads] reads_subset[OF return_reads]
      reads_subset[OF element_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I
      bind_pure_I
      split: list.splits)
end

locale l_get_host = l_get_host_defs +
  assumes get_host_pure [simp]: "pure (get_host element_ptr) h"
  assumes get_host_reads: "reads get_host_locs (get_host node_ptr) h h'"


interpretation i_get_host?: l_get_hostShadow_DOM get_shadow_root get_shadow_root_locs get_host
  get_host_locs type_wf
  using instances
  by (simp add: l_get_hostShadow_DOM_def l_get_hostShadow_DOM_axioms_def get_host_def get_host_locs_def)
declare l_get_hostShadow_DOM_axioms [instances]

lemma get_host_is_l_get_host [instances]: "l_get_host get_host get_host_locs"
  apply(auto simp add: l_get_host_def)[1]
  using get_host_reads apply fast
  done



subsubsection ‹get\_mode›

locale l_get_modeShadow_DOM_defs
begin
definition a_get_mode :: "(_) shadow_root_ptr ⇒ (_, shadow_root_mode) dom_prog"
  where
    "a_get_mode shadow_root_ptr = get_M shadow_root_ptr mode"

definition a_get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  where
    "a_get_mode_locs shadow_root_ptr ≡ {preserved (get_M shadow_root_ptr mode)}"
end

global_interpretation l_get_modeShadow_DOM_defs
  defines get_mode = a_get_mode
    and get_mode_locs = a_get_mode_locs
  .

locale l_get_mode_defs =
  fixes get_mode :: "(_) shadow_root_ptr ⇒ (_, shadow_root_mode) dom_prog"
  fixes get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_modeShadow_DOM =
  l_get_modeShadow_DOM_defs +
  l_get_mode_defs get_mode get_mode_locs +
  l_type_wf type_wf
  for get_mode :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, shadow_root_mode) prog"
    and get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and type_wf :: "(_) heap ⇒ bool" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes get_mode_impl: "get_mode = a_get_mode"
  assumes get_mode_locs_impl: "get_mode_locs = a_get_mode_locs"
begin
lemmas get_mode_def = get_mode_impl[unfolded get_mode_def a_get_mode_def]
lemmas get_mode_locs_def = get_mode_locs_impl[unfolded get_mode_locs_def a_get_mode_locs_def]

lemma get_mode_ok: "type_wf h ⟹ shadow_root_ptr |∈| shadow_root_ptr_kinds h ⟹
  h ⊢ ok (get_mode shadow_root_ptr)"
  unfolding get_mode_def type_wf_impl
  using ShadowRootMonad.get_MShadowRoot_ok by blast

lemma get_mode_pure [simp]: "pure (get_mode element_ptr) h"
  unfolding get_mode_def by simp

lemma get_mode_ptr_in_heap:
  assumes "h ⊢ get_mode shadow_root_ptr →r children"
  shows "shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  using assms
  by(auto simp add: get_mode_def get_MShadowRoot_ptr_in_heap dest: is_OK_returns_result_I)

lemma get_mode_reads: "reads (get_mode_locs element_ptr) (get_mode element_ptr) h h'"
  by(simp add: get_mode_def get_mode_locs_def reads_bind_pure reads_insert_writes_set_right)
end

interpretation i_get_mode?: l_get_modeShadow_DOM get_mode get_mode_locs type_wf
  using instances
  by (auto simp add: l_get_modeShadow_DOM_def)
declare l_get_modeShadow_DOM_axioms [instances]

locale l_get_mode = l_type_wf + l_get_mode_defs +
  assumes get_mode_reads: "reads (get_mode_locs shadow_root_ptr) (get_mode shadow_root_ptr) h h'"
  assumes get_mode_ok:
    "type_wf h ⟹ shadow_root_ptr |∈| shadow_root_ptr_kinds h ⟹ h ⊢ ok (get_mode shadow_root_ptr)"
  assumes get_mode_ptr_in_heap:
    "h ⊢ ok (get_mode shadow_root_ptr) ⟹ shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  assumes get_mode_pure [simp]: "pure (get_mode shadow_root_ptr) h"

lemma get_mode_is_l_get_mode [instances]: "l_get_mode type_wf get_mode get_mode_locs"
  apply(auto simp add: l_get_mode_def instances)[1]
  using get_mode_reads apply blast
  using get_mode_ok apply blast
  using get_mode_ptr_in_heap apply blast
  done

subsubsection ‹get\_shadow\_root\_safe›

locale l_get_shadow_root_safeShadow_DOM_defs =
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
  l_get_mode_defs get_mode get_mode_locs
  for get_shadow_root :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_mode :: "(_) shadow_root_ptr ⇒ (_, shadow_root_mode) dom_prog"
    and get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_get_shadow_root_safe :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
  where
    "a_get_shadow_root_safe element_ptr = do {
      shadow_root_ptr_opt ← get_shadow_root element_ptr;
      (case shadow_root_ptr_opt of
        Some shadow_root_ptr ⇒ do {
          mode ← get_mode shadow_root_ptr;
          (if mode = Open then
            return (Some shadow_root_ptr)
          else
            return None
          )
        } | None ⇒ return None)
    }"

definition a_get_shadow_root_safe_locs
  :: "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" where
  "a_get_shadow_root_safe_locs element_ptr shadow_root_ptr ≡
    (get_shadow_root_locs element_ptr) ∪ (get_mode_locs shadow_root_ptr)"
end

global_interpretation l_get_shadow_root_safeShadow_DOM_defs get_shadow_root get_shadow_root_locs
  get_mode get_mode_locs
  defines get_shadow_root_safe = a_get_shadow_root_safe
    and get_shadow_root_safe_locs = a_get_shadow_root_safe_locs
  .

locale l_get_shadow_root_safe_defs =
  fixes get_shadow_root_safe :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
  fixes get_shadow_root_safe_locs ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_shadow_root_safeShadow_DOM =
  l_get_shadow_root_safeShadow_DOM_defs get_shadow_root get_shadow_root_locs get_mode get_mode_locs +
  l_get_shadow_root_safe_defs get_shadow_root_safe get_shadow_root_safe_locs +
  l_get_shadow_root  type_wf get_shadow_root get_shadow_root_locs +
  l_get_mode  type_wf get_mode get_mode_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root_safe ::
    "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_safe_locs ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ (_, (_) shadow_root_ptr option) dom_prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_mode :: "(_) shadow_root_ptr ⇒ (_, shadow_root_mode) dom_prog"
    and get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
  assumes get_shadow_root_safe_impl: "get_shadow_root_safe = a_get_shadow_root_safe"
  assumes get_shadow_root_safe_locs_impl: "get_shadow_root_safe_locs = a_get_shadow_root_safe_locs"
begin
lemmas get_shadow_root_safe_def =
  get_shadow_root_safe_impl[unfolded get_shadow_root_safe_def a_get_shadow_root_safe_def]
lemmas get_shadow_root_safe_locs_def =
  get_shadow_root_safe_locs_impl[unfolded get_shadow_root_safe_locs_def a_get_shadow_root_safe_locs_def]

lemma get_shadow_root_safe_pure [simp]: "pure (get_shadow_root_safe element_ptr) h"
  by (auto simp add: get_shadow_root_safe_def bind_pure_I option.case_eq_if)
end

interpretation i_get_shadow_root_safe?: l_get_shadow_root_safeShadow_DOM type_wf get_shadow_root_safe
  get_shadow_root_safe_locs get_shadow_root get_shadow_root_locs get_mode get_mode_locs
  using instances
  by (auto simp add: l_get_shadow_root_safeShadow_DOM_def l_get_shadow_root_safeShadow_DOM_axioms_def
      get_shadow_root_safe_def get_shadow_root_safe_locs_def)
declare l_get_shadow_root_safeShadow_DOM_axioms [instances]

locale l_get_shadow_root_safe = l_get_shadow_root_safe_defs +
  assumes get_shadow_root_safe_pure [simp]: "pure (get_shadow_root_safe element_ptr) h"

lemma get_shadow_root_safe_is_l_get_shadow_root_safe [instances]:
  "l_get_shadow_root_safe get_shadow_root_safe"
  using instances
  apply(auto simp add: l_get_shadow_root_safe_def)[1]
  done

subsubsection ‹set\_disconnected\_nodes›

locale l_set_disconnected_nodesShadow_DOM =
  CD: l_set_disconnected_nodesCore_DOM type_wfCore_DOM set_disconnected_nodes set_disconnected_nodes_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and set_disconnected_nodes ::
    "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
begin
lemma set_disconnected_nodes_ok:
  "type_wf h ⟹ document_ptr |∈| document_ptr_kinds h ⟹
    h ⊢ ok (set_disconnected_nodes document_ptr node_ptrs)"
  using CD.set_disconnected_nodes_ok CD.type_wf_impl ShadowRootClass.type_wf_defs local.type_wf_impl
  by blast

lemma set_disconnected_nodes_typess_preserved:
  assumes "w ∈ set_disconnected_nodes_locs object_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
  apply(unfold type_wf_impl)
  by(auto simp add: all_args_def CD.set_disconnected_nodes_locs_def split: if_splits)
end

interpretation i_set_disconnected_nodes?: l_set_disconnected_nodesShadow_DOM type_wf
  DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs
  by(auto simp add: l_set_disconnected_nodesShadow_DOM_def
      l_set_disconnected_nodesShadow_DOM_axioms_def instances)
declare l_set_disconnected_nodesShadow_DOM_axioms [instances]

lemma set_disconnected_nodes_is_l_set_disconnected_nodes [instances]:
  "l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs"
  apply(auto simp add: l_set_disconnected_nodes_def)[1]
        apply (simp add: i_set_disconnected_nodes.set_disconnected_nodes_writes)
  using set_disconnected_nodes_ok apply blast
      apply (simp add: i_set_disconnected_nodes.set_disconnected_nodes_ptr_in_heap)
  using i_set_disconnected_nodes.set_disconnected_nodes_pointers_preserved apply (blast, blast)
  using set_disconnected_nodes_typess_preserved apply(blast, blast)
  done


paragraph ‹get\_child\_nodes›

locale l_set_disconnected_nodes_get_child_nodesShadow_DOM =
  l_set_disconnected_nodesCore_DOM type_wfCore_DOM set_disconnected_nodes set_disconnected_nodes_locs +
  l_get_child_nodesShadow_DOM type_wf known_ptr type_wfCore_DOM known_ptrCore_DOM get_child_nodes
  get_child_nodes_locs get_child_nodesCore_DOM get_child_nodes_locsCore_DOM
  for type_wf :: "(_) heap ⇒ bool"
    and set_disconnected_nodes :: "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit)
    prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_child_nodesCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locsCore_DOM :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin

lemma set_disconnected_nodes_get_child_nodes:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_child_nodes_locs ptr'. r h h'))"
  by(auto simp add: set_disconnected_nodes_locs_def get_child_nodes_locs_def
      CD.get_child_nodes_locs_def all_args_def)
end

interpretation i_set_disconnected_nodes_get_child_nodes?:
  l_set_disconnected_nodes_get_child_nodesShadow_DOM type_wf set_disconnected_nodes
  set_disconnected_nodes_locs known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
  get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
  by(auto simp add: l_set_disconnected_nodes_get_child_nodesShadow_DOM_def instances)
declare l_set_disconnected_nodes_get_child_nodesShadow_DOM_axioms[instances]

lemma set_disconnected_nodes_get_child_nodes_is_l_set_disconnected_nodes_get_child_nodes [instances]:
  "l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes_locs get_child_nodes_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_child_nodes_def)[1]
  using set_disconnected_nodes_get_child_nodes apply fast
  done


paragraph ‹get\_host›

locale l_set_disconnected_nodes_get_hostShadow_DOM =
  l_set_disconnected_nodesShadow_DOM +
  l_get_shadow_rootShadow_DOM +
  l_get_hostShadow_DOM
begin
lemma set_disconnected_nodes_get_host:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_host_locs. r h h'))"
  by(auto simp add: CD.set_disconnected_nodes_locs_def get_shadow_root_locs_def get_host_locs_def all_args_def)
end

interpretation i_set_disconnected_nodes_get_host?: l_set_disconnected_nodes_get_hostShadow_DOM type_wf
  DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_shadow_root
  get_shadow_root_locs get_host get_host_locs
  by(auto simp add: l_set_disconnected_nodes_get_hostShadow_DOM_def instances)
declare l_set_disconnected_nodes_get_hostShadow_DOM_axioms [instances]

locale l_set_disconnected_nodes_get_host = l_set_disconnected_nodes_defs + l_get_host_defs +
  assumes set_disconnected_nodes_get_host:
    "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_host_locs. r h h'))"

lemma set_disconnected_nodes_get_host_is_l_set_disconnected_nodes_get_host [instances]:
  "l_set_disconnected_nodes_get_host set_disconnected_nodes_locs get_host_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_host_def instances)[1]
  using set_disconnected_nodes_get_host
  by fast



subsubsection ‹get\_tag\_name›

locale l_get_tag_nameShadow_DOM =
  CD: l_get_tag_nameCore_DOM type_wfCore_DOM get_tag_name get_tag_name_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_tag_name :: "(_) element_ptr ⇒ (_, tag_name) dom_prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
begin

lemma get_tag_name_ok:
  "type_wf h ⟹ element_ptr |∈| element_ptr_kinds h ⟹ h ⊢ ok (get_tag_name element_ptr)"
  apply(unfold type_wf_impl get_tag_name_impl[unfolded a_get_tag_name_def])
  using CD.get_tag_name_ok CD.type_wf_impl ShadowRootClass.type_wfDocument
  by blast
end

interpretation i_get_tag_name?: l_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name
  get_tag_name_locs
  by(auto simp add: l_get_tag_nameShadow_DOM_def l_get_tag_nameShadow_DOM_axioms_def instances)
declare l_get_tag_nameShadow_DOM_axioms [instances]

lemma get_tag_name_is_l_get_tag_name [instances]: "l_get_tag_name type_wf get_tag_name
  get_tag_name_locs"
  apply(auto simp add: l_get_tag_name_def)[1]
  using get_tag_name_reads apply fast
  using get_tag_name_ok apply fast
  done


paragraph ‹set\_disconnected\_nodes›

locale l_set_disconnected_nodes_get_tag_nameShadow_DOM =
  l_set_disconnected_nodesShadow_DOM +
  l_get_tag_nameShadow_DOM
begin
lemma set_disconnected_nodes_get_tag_name:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"
  by(auto simp add: CD.set_disconnected_nodes_locs_def CD.get_tag_name_locs_def all_args_def)
end

interpretation i_set_disconnected_nodes_get_tag_name?: l_set_disconnected_nodes_get_tag_nameShadow_DOM
  type_wf DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_tag_name
  get_tag_name_locs
  by(auto simp add: l_set_disconnected_nodes_get_tag_nameShadow_DOM_def instances)
declare l_set_disconnected_nodes_get_tag_nameShadow_DOM_axioms [instances]

lemma set_disconnected_nodes_get_tag_name_is_l_set_disconnected_nodes_get_tag_name [instances]:
  "l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
  get_tag_name get_tag_name_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_tag_name_def
      l_set_disconnected_nodes_get_tag_name_axioms_def instances)[1]
  using set_disconnected_nodes_get_tag_name
  by fast


paragraph ‹set\_child\_nodes›

locale l_set_child_nodes_get_tag_nameShadow_DOM =
  l_set_child_nodesShadow_DOM +
  l_get_tag_nameShadow_DOM
begin
lemma set_child_nodes_get_tag_name:
  "∀w ∈ set_child_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"
  by(auto simp add: CD.set_child_nodes_locs_def set_child_nodes_locs_def CD.get_tag_name_locs_def
      all_args_def
      intro: element_put_get_preserved[where getter=tag_name and
        setter=RElement.child_nodes_update])
end

interpretation i_set_child_nodes_get_tag_name?: l_set_child_nodes_get_tag_nameShadow_DOM type_wf
  known_ptr DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
  Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_tag_name
  get_tag_name_locs
  by(auto simp add: l_set_child_nodes_get_tag_nameShadow_DOM_def instances)
declare l_set_child_nodes_get_tag_nameShadow_DOM_axioms [instances]

lemma set_child_nodes_get_tag_name_is_l_set_child_nodes_get_tag_name [instances]:
  "l_set_child_nodes_get_tag_name type_wf set_child_nodes set_child_nodes_locs get_tag_name
  get_tag_name_locs"
  apply(auto simp add: l_set_child_nodes_get_tag_name_def l_set_child_nodes_get_tag_name_axioms_def
      instances)[1]
  using set_child_nodes_get_tag_name
  by fast


paragraph ‹delete\_shadow\_root›

locale l_delete_shadow_root_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM
begin
lemma get_tag_name_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  by(auto simp add: CD.get_tag_name_locs_def delete_shadow_root_get_MElement)
end

locale l_delete_shadow_root_get_tag_name = l_get_tag_name_defs +
  assumes get_tag_name_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
interpretation l_delete_shadow_root_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name
  get_tag_name_locs
  by(auto simp add: l_delete_shadow_root_get_tag_nameShadow_DOM_def instances)

lemma l_delete_shadow_root_get_tag_name_get_tag_name_locs [instances]: "l_delete_shadow_root_get_tag_name get_tag_name_locs"
  apply(auto simp add: l_delete_shadow_root_get_tag_name_def)[1]
  using get_tag_name_delete_shadow_root apply fast
  done


paragraph ‹set\_shadow\_root›

locale l_set_shadow_root_get_tag_nameShadow_DOM =
  l_set_shadow_rootShadow_DOM +
  l_get_tag_nameShadow_DOM
begin
lemma set_shadow_root_get_tag_name:
  "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"
  by(auto simp add: set_shadow_root_locs_def CD.get_tag_name_locs_def all_args_def
      element_put_get_preserved[where setter=shadow_root_opt_update])
end

interpretation i_set_shadow_root_get_tag_name?: l_set_shadow_root_get_tag_nameShadow_DOM type_wf
  set_shadow_root set_shadow_root_locs DocumentClass.type_wf get_tag_name get_tag_name_locs
  apply(auto simp add: l_set_shadow_root_get_tag_nameShadow_DOM_def instances)[1]
  by(unfold_locales)
declare l_set_shadow_root_get_tag_nameShadow_DOM_axioms[instances]

locale l_set_shadow_root_get_tag_name = l_set_shadow_root_defs + l_get_tag_name_defs +
  assumes set_shadow_root_get_tag_name:
    "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"

lemma set_shadow_root_get_tag_name_is_l_set_shadow_root_get_tag_name [instances]:
  "l_set_shadow_root_get_tag_name set_shadow_root_locs get_tag_name_locs"
  using set_shadow_root_is_l_set_shadow_root get_tag_name_is_l_get_tag_name
  apply(simp add: l_set_shadow_root_get_tag_name_def )
  using set_shadow_root_get_tag_name
  by fast

paragraph ‹new\_element›

locale l_new_element_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM type_wf type_wfCore_DOM get_tag_name get_tag_name_locs
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_tag_name :: "(_) element_ptr ⇒ (_, tag_name) dom_prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_tag_name_new_element:
  "ptr' ≠ new_element_ptr ⟹ h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
     ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  by (auto simp add: CD.get_tag_name_locs_def new_element_get_MObject new_element_get_MElement
      new_element_get_MDocument split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)

lemma new_element_empty_tag_name:
  "h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
   ⟹ h' ⊢ get_tag_name new_element_ptr →r ''''"
  by(simp add: CD.get_tag_name_def new_element_tag_name)
end

locale l_new_element_get_tag_name = l_new_element + l_get_tag_name +
  assumes get_tag_name_new_element:
    "ptr' ≠ new_element_ptr ⟹ h ⊢ new_element →r new_element_ptr
            ⟹ h ⊢ new_element →h h' ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  assumes new_element_empty_tag_name:
    "h ⊢ new_element →r new_element_ptr ⟹ h ⊢ new_element →h h'
            ⟹ h' ⊢ get_tag_name new_element_ptr →r ''''"


interpretation i_new_element_get_tag_name?:
  l_new_element_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name get_tag_name_locs
  by(auto simp add: l_new_element_get_tag_nameShadow_DOM_def instances)
declare l_new_element_get_tag_nameShadow_DOM_axioms [instances]

lemma new_element_get_tag_name_is_l_new_element_get_tag_name [instances]:
  "l_new_element_get_tag_name type_wf get_tag_name get_tag_name_locs"
  using new_element_is_l_new_element get_tag_name_is_l_get_tag_name
  apply(auto simp add: l_new_element_get_tag_name_def l_new_element_get_tag_name_axioms_def
      instances)[1]
  using get_tag_name_new_element new_element_empty_tag_name
  by fast+

paragraph ‹get\_shadow\_root›

locale l_set_mode_get_tag_nameShadow_DOM =
  l_set_modeShadow_DOM +
  l_get_tag_nameShadow_DOM
begin
lemma set_mode_get_tag_name:
  "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"
  by(auto simp add: set_mode_locs_def CD.get_tag_name_locs_def all_args_def)
end

interpretation
  i_set_mode_get_tag_name?: l_set_mode_get_tag_nameShadow_DOM type_wf
  set_mode set_mode_locs  DocumentClass.type_wf get_tag_name
  get_tag_name_locs
  by unfold_locales
declare l_set_mode_get_tag_nameShadow_DOM_axioms[instances]

locale l_set_mode_get_tag_name = l_set_mode + l_get_tag_name +
  assumes set_mode_get_tag_name:
    "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"

lemma set_mode_get_tag_name_is_l_set_mode_get_tag_name [instances]:
  "l_set_mode_get_tag_name type_wf set_mode set_mode_locs get_tag_name
                                         get_tag_name_locs"
  using set_mode_is_l_set_mode get_tag_name_is_l_get_tag_name
  apply(simp add: l_set_mode_get_tag_name_def
      l_set_mode_get_tag_name_axioms_def)
  using set_mode_get_tag_name
  by fast

paragraph ‹new\_document›

locale l_new_document_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM type_wf type_wfCore_DOM get_tag_name get_tag_name_locs
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, tag_name) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_tag_name_new_document:
  "h ⊢ new_document →r new_document_ptr ⟹ h ⊢ new_document →h h'
       ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  by(auto simp add: CD.get_tag_name_locs_def new_document_get_MElement)
end

locale l_new_document_get_tag_name = l_get_tag_name_defs +
  assumes get_tag_name_new_document:
    "h ⊢ new_document →r new_document_ptr ⟹ h ⊢ new_document →h h'
       ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"

interpretation i_new_document_get_tag_name?:
  l_new_document_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name
  get_tag_name_locs
  by unfold_locales
declare l_new_document_get_tag_nameShadow_DOM_def[instances]

lemma new_document_get_tag_name_is_l_new_document_get_tag_name [instances]:
  "l_new_document_get_tag_name get_tag_name_locs"
  unfolding l_new_document_get_tag_name_def
  unfolding get_tag_name_locs_def
  using new_document_get_MElement by blast

paragraph ‹new\_shadow\_root›

locale l_new_shadow_root_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM
begin
lemma get_tag_name_new_shadow_root:
  "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
     ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  by (auto simp add: CD.get_tag_name_locs_def new_shadow_root_get_MObject new_shadow_root_get_MElement
      split: prod.splits if_splits option.splits
      elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
end

locale l_new_shadow_root_get_tag_name = l_get_tag_name +
  assumes get_tag_name_new_shadow_root:
    "h ⊢ newShadowRoot_M →r new_shadow_root_ptr
            ⟹ h ⊢ newShadowRoot_M →h h' ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"

interpretation i_new_shadow_root_get_tag_name?:
  l_new_shadow_root_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name get_tag_name_locs
  by(unfold_locales)
declare l_new_shadow_root_get_tag_nameShadow_DOM_axioms [instances]

lemma new_shadow_root_get_tag_name_is_l_new_shadow_root_get_tag_name [instances]:
  "l_new_shadow_root_get_tag_name type_wf get_tag_name get_tag_name_locs"
  using get_tag_name_is_l_get_tag_name
  apply(auto simp add: l_new_shadow_root_get_tag_name_def l_new_shadow_root_get_tag_name_axioms_def
      instances)[1]
  using get_tag_name_new_shadow_root
  by fast

paragraph ‹new\_character\_data›

locale l_new_character_data_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM type_wf type_wfCore_DOM get_tag_name get_tag_name_locs
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, tag_name) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_tag_name_new_character_data:
  "h ⊢ new_character_data →r new_character_data_ptr ⟹ h ⊢ new_character_data →h h'
       ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"
  by(auto simp add: CD.get_tag_name_locs_def new_character_data_get_MElement)
end

locale l_new_character_data_get_tag_name = l_get_tag_name_defs +
  assumes get_tag_name_new_character_data:
    "h ⊢ new_character_data →r new_character_data_ptr ⟹ h ⊢ new_character_data →h h'
       ⟹ r ∈ get_tag_name_locs ptr' ⟹ r h h'"

interpretation i_new_character_data_get_tag_name?:
  l_new_character_data_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name
  get_tag_name_locs
  by unfold_locales
declare l_new_character_data_get_tag_nameShadow_DOM_def[instances]

lemma new_character_data_get_tag_name_is_l_new_character_data_get_tag_name [instances]:
  "l_new_character_data_get_tag_name get_tag_name_locs"
  unfolding l_new_character_data_get_tag_name_def
  unfolding get_tag_name_locs_def
  using new_character_data_get_MElement by blast

paragraph ‹get\_tag\_type›

locale l_set_tag_name_get_tag_nameShadow_DOM = l_get_tag_nameShadow_DOM
  + l_set_tag_nameShadow_DOM
begin
lemma set_tag_name_get_tag_name:
  assumes "h ⊢ CD.a_set_tag_name element_ptr tag →h h'"
  shows "h' ⊢ CD.a_get_tag_name element_ptr →r tag"
  using assms
  by(auto simp add: CD.a_get_tag_name_def CD.a_set_tag_name_def)

lemma set_tag_name_get_tag_name_different_pointers:
  assumes "ptr ≠ ptr'"
  assumes "w ∈ CD.a_set_tag_name_locs ptr"
  assumes "h ⊢ w →h h'"
  assumes "r ∈ CD.a_get_tag_name_locs ptr'"
  shows "r h h'"
  using assms
  by(auto simp add: all_args_def CD.a_set_tag_name_locs_def CD.a_get_tag_name_locs_def
      split: if_splits option.splits )
end

interpretation i_set_tag_name_get_tag_name?:
  l_set_tag_name_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf get_tag_name
  get_tag_name_locs set_tag_name set_tag_name_locs
  by unfold_locales
declare l_set_tag_name_get_tag_nameShadow_DOM_axioms[instances]

lemma set_tag_name_get_tag_name_is_l_set_tag_name_get_tag_name [instances]:
  "l_set_tag_name_get_tag_name  type_wf get_tag_name get_tag_name_locs
                                                    set_tag_name set_tag_name_locs"
  using set_tag_name_is_l_set_tag_name get_tag_name_is_l_get_tag_name
  apply(simp add: l_set_tag_name_get_tag_name_def
      l_set_tag_name_get_tag_name_axioms_def)
  using set_tag_name_get_tag_name
    set_tag_name_get_tag_name_different_pointers
  by fast+


subsubsection ‹attach\_shadow\_root›

locale l_attach_shadow_rootShadow_DOM_defs =
  l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
  l_set_mode_defs set_mode set_mode_locs +
  l_get_tag_name_defs get_tag_name get_tag_name_locs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
  for set_shadow_root ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ ((_) heap, exception, unit) prog"
    and set_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ ((_) heap, exception, unit) prog"
    and set_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, unit) prog set"
    and get_tag_name :: "(_) element_ptr ⇒ (_, char list) dom_prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_attach_shadow_root ::
  "(_) element_ptr ⇒ shadow_root_mode ⇒ (_, (_) shadow_root_ptr) dom_prog"
  where
    "a_attach_shadow_root element_ptr shadow_root_mode = do {
      tag ← get_tag_name element_ptr;
      (if tag ∉ safe_shadow_root_element_types then error NotSupportedError else return ());
      prev_shadow_root ← get_shadow_root element_ptr;
      (if prev_shadow_root ≠ None then error NotSupportedError else return ());
      new_shadow_root_ptr ← newShadowRoot_M;
      set_mode new_shadow_root_ptr shadow_root_mode;
      set_shadow_root element_ptr (Some new_shadow_root_ptr);
      return new_shadow_root_ptr
    }"
end

locale l_attach_shadow_root_defs =
  fixes attach_shadow_root ::
    "(_) element_ptr ⇒ shadow_root_mode ⇒ (_, (_) shadow_root_ptr) dom_prog"

global_interpretation l_attach_shadow_rootShadow_DOM_defs set_shadow_root set_shadow_root_locs
  set_mode set_mode_locs get_tag_name get_tag_name_locs get_shadow_root get_shadow_root_locs
  defines attach_shadow_root = a_attach_shadow_root
  .

locale l_attach_shadow_rootShadow_DOM =
  l_attach_shadow_rootShadow_DOM_defs set_shadow_root set_shadow_root_locs set_mode set_mode_locs
  get_tag_name get_tag_name_locs get_shadow_root get_shadow_root_locs +
  l_attach_shadow_root_defs attach_shadow_root +
  l_set_shadow_rootShadow_DOM type_wf set_shadow_root set_shadow_root_locs +
  l_set_mode type_wf set_mode set_mode_locs +
  l_get_tag_name type_wf get_tag_name get_tag_name_locs +
  l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs +
  l_known_ptr known_ptr
  for known_ptr :: "(_) object_ptr ⇒ bool"
    and set_shadow_root ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ ((_) heap, exception, unit) prog"
    and set_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ ((_) heap, exception, unit) prog"
    and set_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, unit) prog set"
    and attach_shadow_root ::
    "(_) element_ptr ⇒ shadow_root_mode ⇒ ((_) heap, exception, (_) shadow_root_ptr) prog"
    and type_wf :: "(_) heap ⇒ bool"
    and get_tag_name :: "(_) element_ptr ⇒ (_, char list) dom_prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes known_ptr_impl: "known_ptr = a_known_ptr"
  assumes attach_shadow_root_impl: "attach_shadow_root = a_attach_shadow_root"
begin
lemmas attach_shadow_root_def = a_attach_shadow_root_def[folded attach_shadow_root_impl]

lemma attach_shadow_root_element_ptr_in_heap:
  assumes "h ⊢ ok (attach_shadow_root element_ptr shadow_root_mode)"
  shows "element_ptr |∈| element_ptr_kinds h"
proof -
  obtain h' where "h ⊢ attach_shadow_root element_ptr shadow_root_mode →h h'"
    using assms by auto
  then
  obtain h2 h3 new_shadow_root_ptr where
    h2: "h ⊢ newShadowRoot_M →h h2" and
    new_shadow_root_ptr: "h ⊢ newShadowRoot_M →r new_shadow_root_ptr" and
    h3: "h2 ⊢ set_mode new_shadow_root_ptr shadow_root_mode →h h3" and
    "h3 ⊢ set_shadow_root element_ptr (Some new_shadow_root_ptr) →h h'"
    by(auto simp add: attach_shadow_root_def
        elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_tag_name_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated] split: if_splits)

  then have "element_ptr |∈| element_ptr_kinds h3"
    using set_shadow_root_ptr_in_heap by blast

  moreover
  have "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|cast new_shadow_root_ptr|}"
    using h2 newShadowRoot_M_new_ptr new_shadow_root_ptr by auto

  moreover
  have "object_ptr_kinds h2 = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
          OF set_mode_writes h3])
    using set_mode_pointers_preserved
      apply blast
    by (auto simp add: reflp_def transp_def)
  ultimately
  show ?thesis
    by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
qed

lemma create_shadow_root_known_ptr:
  assumes "h ⊢ attach_shadow_root element_ptr shadow_root_mode →r new_shadow_root_ptr"
  shows "known_ptr (castshadow_root_ptr2object_ptr new_shadow_root_ptr)"
  using assms
  by(auto simp add: attach_shadow_root_def known_ptr_impl ShadowRootClass.a_known_ptr_def
      newShadowRoot_M_def newShadowRoot_def Let_def
      elim!: bind_returns_result_E)
end

locale l_attach_shadow_root = l_attach_shadow_root_defs

interpretation
  i_attach_shadow_root?: l_attach_shadow_rootShadow_DOM known_ptr set_shadow_root set_shadow_root_locs
  set_mode set_mode_locs attach_shadow_root type_wf get_tag_name get_tag_name_locs get_shadow_root
  get_shadow_root_locs
  by(auto simp add: l_attach_shadow_rootShadow_DOM_def l_attach_shadow_rootShadow_DOM_axioms_def
      attach_shadow_root_def instances)
declare l_attach_shadow_rootShadow_DOM_axioms [instances]



subsubsection ‹get\_parent›

global_interpretation l_get_parentCore_DOM_defs get_child_nodes get_child_nodes_locs
  defines get_parent = "l_get_parentCore_DOM_defs.a_get_parent get_child_nodes"
    and get_parent_locs = "l_get_parentCore_DOM_defs.a_get_parent_locs get_child_nodes_locs"
  .

interpretation i_get_parent?: l_get_parentCore_DOM known_ptr type_wf get_child_nodes
  get_child_nodes_locs known_ptrs get_parent get_parent_locs
  by(simp add: l_get_parentCore_DOM_def l_get_parentCore_DOM_axioms_def get_parent_def
      get_parent_locs_def instances)
declare l_get_parentCore_DOM_axioms [instances]

lemma get_parent_is_l_get_parent [instances]: "l_get_parent type_wf known_ptr known_ptrs get_parent
    get_parent_locs get_child_nodes get_child_nodes_locs"
  apply(simp add: l_get_parent_def l_get_parent_axioms_def instances)
  using get_parent_reads get_parent_ok get_parent_ptr_in_heap get_parent_pure
    get_parent_parent_in_heap get_parent_child_dual get_parent_reads_pointers
  by blast



paragraph ‹set\_disconnected\_nodes›

locale l_set_disconnected_nodes_get_parentShadow_DOM =
  l_set_disconnected_nodes_get_child_nodes
  + l_set_disconnected_nodesShadow_DOM
  + l_get_parentCore_DOM
begin
lemma set_disconnected_nodes_get_parent [simp]:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_parent_locs. r h h'))"
  by(auto simp add: get_parent_locs_def CD.set_disconnected_nodes_locs_def all_args_def)
end
interpretation i_set_disconnected_nodes_get_parent?: l_set_disconnected_nodes_get_parentShadow_DOM
  set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs type_wf
  DocumentClass.type_wf known_ptr known_ptrs get_parent get_parent_locs
  by (simp add: l_set_disconnected_nodes_get_parentShadow_DOM_def instances)
declare l_set_disconnected_nodes_get_parentCore_DOM_axioms[instances]

lemma set_disconnected_nodes_get_parent_is_l_set_disconnected_nodes_get_parent [instances]:
  "l_set_disconnected_nodes_get_parent set_disconnected_nodes_locs get_parent_locs"
  by(simp add: l_set_disconnected_nodes_get_parent_def)



subsubsection ‹get\_root\_node›

global_interpretation l_get_root_nodeCore_DOM_defs get_parent get_parent_locs
  defines get_root_node = "l_get_root_nodeCore_DOM_defs.a_get_root_node get_parent"
    and get_root_node_locs = "l_get_root_nodeCore_DOM_defs.a_get_root_node_locs get_parent_locs"
    and get_ancestors = "l_get_root_nodeCore_DOM_defs.a_get_ancestors get_parent"
    and get_ancestors_locs = "l_get_root_nodeCore_DOM_defs.a_get_ancestors_locs get_parent_locs"
  .
declare a_get_ancestors.simps [code]

interpretation i_get_root_node?: l_get_root_nodeCore_DOM type_wf known_ptr known_ptrs get_parent
  get_parent_locs get_child_nodes get_child_nodes_locs get_ancestors get_ancestors_locs
  get_root_node get_root_node_locs
  by(simp add: l_get_root_nodeCore_DOM_def l_get_root_nodeCore_DOM_axioms_def get_root_node_def
      get_root_node_locs_def get_ancestors_def get_ancestors_locs_def instances)
declare l_get_root_nodeCore_DOM_axioms [instances]

lemma get_ancestors_is_l_get_ancestors [instances]: "l_get_ancestors get_ancestors"
  apply(auto simp add: l_get_ancestors_def)[1]
  using get_ancestors_ptr_in_heap apply fast
  using get_ancestors_ptr apply fast
  done

lemma get_root_node_is_l_get_root_node [instances]: "l_get_root_node get_root_node get_parent"
  by (simp add: l_get_root_node_def Shadow_DOM.i_get_root_node.get_root_node_no_parent)



subsubsection ‹get\_root\_node\_si›

locale l_get_root_node_siShadow_DOM_defs =
  l_get_parent_defs get_parent get_parent_locs +
  l_get_host_defs get_host get_host_locs
  for get_parent :: "(_) node_ptr ⇒ ((_) heap, exception, (_::linorder) object_ptr option) prog"
    and get_parent_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
begin
partial_function (dom_prog) a_get_ancestors_si ::
  "(_::linorder) object_ptr ⇒ (_, (_) object_ptr list) dom_prog"
  where
    "a_get_ancestors_si ptr = do {
      check_in_heap ptr;
      ancestors ← (case castobject_ptr2node_ptr ptr of
        Some node_ptr ⇒ do {
          parent_ptr_opt ← get_parent node_ptr;
          (case parent_ptr_opt of
            Some parent_ptr ⇒ a_get_ancestors_si parent_ptr
          | None ⇒ return [])
        }
      | None ⇒ (case cast ptr of
          Some shadow_root_ptr ⇒ do {
            host ← get_host shadow_root_ptr;
            a_get_ancestors_si (cast host)
          } |
          None ⇒ return []));
      return (ptr # ancestors)
    }"

definition "a_get_ancestors_si_locs = get_parent_locs ∪ get_host_locs"

definition a_get_root_node_si :: "(_) object_ptr ⇒ (_, (_) object_ptr) dom_prog"
  where
    "a_get_root_node_si ptr = do {
      ancestors ← a_get_ancestors_si ptr;
      return (last ancestors)
    }"
definition "a_get_root_node_si_locs = a_get_ancestors_si_locs"
end

locale l_get_ancestors_si_defs =
  fixes get_ancestors_si :: "(_::linorder) object_ptr ⇒ (_, (_) object_ptr list) dom_prog"
  fixes get_ancestors_si_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_root_node_si_defs =
  fixes get_root_node_si :: "(_) object_ptr ⇒ (_, (_) object_ptr) dom_prog"
  fixes get_root_node_si_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_root_node_siShadow_DOM =
  l_get_parent +
  l_get_host +
  l_get_root_node_siShadow_DOM_defs +
  l_get_ancestors_si_defs +
  l_get_root_node_si_defs +
  assumes get_ancestors_si_impl: "get_ancestors_si = a_get_ancestors_si"
  assumes get_ancestors_si_locs_impl: "get_ancestors_si_locs = a_get_ancestors_si_locs"
  assumes get_root_node_si_impl: "get_root_node_si = a_get_root_node_si"
  assumes get_root_node_si_locs_impl: "get_root_node_si_locs = a_get_root_node_si_locs"
begin
lemmas get_ancestors_si_def = a_get_ancestors_si.simps[folded get_ancestors_si_impl]
lemmas get_ancestors_si_locs_def = a_get_ancestors_si_locs_def[folded get_ancestors_si_locs_impl]
lemmas get_root_node_si_def =
  a_get_root_node_si_def[folded get_root_node_si_impl get_ancestors_si_impl]
lemmas get_root_node_si_locs_def =
  a_get_root_node_si_locs_def[folded get_root_node_si_locs_impl get_ancestors_si_locs_impl]

lemma get_ancestors_si_pure [simp]:
  "pure (get_ancestors_si ptr) h"
proof -
  have "∀ptr h h' x. h ⊢ get_ancestors_si ptr →r x ⟶ h ⊢ get_ancestors_si ptr →h h' ⟶ h = h'"
  proof (induct rule: a_get_ancestors_si.fixp_induct[folded get_ancestors_si_impl])
    case 1
    then show ?case
      by(rule admissible_dom_prog)
  next
    case 2
    then show ?case
      by simp
  next
    case (3 f)
    then show ?case
      using get_parent_pure get_host_pure
      apply(auto simp add: pure_returns_heap_eq pure_def
          split: option.splits
          elim!: bind_returns_heap_E bind_returns_result_E
          dest!: pure_returns_heap_eq[rotated, OF check_in_heap_pure])[1]
        apply (meson option.simps(3) returns_result_eq)
       apply(metis get_parent_pure pure_returns_heap_eq)
      apply(metis get_host_pure pure_returns_heap_eq)
      done
  qed
  then show ?thesis
    by (meson pure_eq_iff)
qed


lemma get_root_node_si_pure [simp]: "pure (get_root_node_si ptr) h"
  by(auto simp add: get_root_node_si_def bind_pure_I)


lemma get_ancestors_si_ptr_in_heap:
  assumes "h ⊢ ok (get_ancestors_si ptr)"
  shows "ptr |∈| object_ptr_kinds h"
  using assms
  by(auto simp add: get_ancestors_si_def check_in_heap_ptr_in_heap elim!: bind_is_OK_E
      dest: is_OK_returns_result_I)

lemma get_ancestors_si_ptr:
  assumes "h ⊢ get_ancestors_si ptr →r ancestors"
  shows "ptr ∈ set ancestors"
  using assms
  by(simp add: get_ancestors_si_def)
    (auto elim!: bind_returns_result_E2
      split: option.splits
      intro!: bind_pure_I)


lemma get_ancestors_si_never_empty:
  assumes "h ⊢ get_ancestors_si child →r ancestors"
  shows "ancestors ≠ []"
  using assms
  apply(simp add: get_ancestors_si_def)
  by(auto elim!: bind_returns_result_E2 split: option.splits)

lemma get_root_node_si_no_parent:
  "h ⊢ get_parent node_ptr →r None ⟹ h ⊢ get_root_node_si (cast node_ptr) →r cast node_ptr"
  apply(auto simp add: check_in_heap_def get_root_node_si_def get_ancestors_si_def
      intro!: bind_pure_returns_result_I )[1]
  using get_parent_ptr_in_heap by blast


lemma get_root_node_si_root_not_shadow_root:
  assumes "h ⊢ get_root_node_si ptr →r root"
  shows "¬ is_shadow_root_ptrobject_ptr root"
  using assms
proof(auto simp add: get_root_node_si_def elim!: bind_returns_result_E2)
  fix y
  assume "h ⊢ get_ancestors_si ptr →r y"
    and "is_shadow_root_ptrobject_ptr (last y)"
    and "root = last y"
  then
  show False
  proof(induct y arbitrary: ptr)
    case Nil
    then show ?case
      using assms(1) get_ancestors_si_never_empty by blast
  next
    case (Cons a x)
    then show ?case
      apply(auto simp add: get_ancestors_si_def[of ptr]
          elim!: bind_returns_result_E2
          split: option.splits if_splits)[1]
      using get_ancestors_si_never_empty apply blast
      using Cons.prems(2) apply auto[1]
      using ‹is_shadow_root_ptrobject_ptr (last y)› ‹root = last y› by auto
  qed
qed
end

global_interpretation l_get_root_node_siShadow_DOM_defs get_parent get_parent_locs get_host get_host_locs
  defines get_root_node_si = a_get_root_node_si
    and get_root_node_si_locs = a_get_root_node_si_locs
    and get_ancestors_si = a_get_ancestors_si
    and get_ancestors_si_locs = a_get_ancestors_si_locs
  .
declare a_get_ancestors_si.simps [code]

interpretation i_get_root_node_si?: l_get_root_node_siShadow_DOM type_wf known_ptr known_ptrs
  get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_host get_host_locs
  get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
  apply(auto simp add: l_get_root_node_siShadow_DOM_def l_get_root_node_siShadow_DOM_axioms_def
      instances)[1]
  by(auto simp add: get_root_node_si_def get_root_node_si_locs_def get_ancestors_si_def
      get_ancestors_si_locs_def)
declare l_get_root_node_siShadow_DOM_axioms[instances]

lemma get_ancestors_si_is_l_get_ancestors [instances]: "l_get_ancestors get_ancestors_si"
  unfolding l_get_ancestors_def
  using get_ancestors_si_pure get_ancestors_si_ptr get_ancestors_si_ptr_in_heap
  by blast

lemma get_root_node_si_is_l_get_root_node [instances]: "l_get_root_node get_root_node_si get_parent"
  apply(simp add: l_get_root_node_def)
  using get_root_node_si_no_parent
  by fast


paragraph ‹set\_disconnected\_nodes›


locale l_set_disconnected_nodes_get_ancestors_siCore_DOM =
  l_set_disconnected_nodes_get_parent
  + l_get_root_node_siShadow_DOM
  + l_set_disconnected_nodesShadow_DOM
  + l_set_disconnected_nodes_get_host
begin
lemma set_disconnected_nodes_get_ancestors_si:
  "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_ancestors_si_locs. r h h'))"
  by(auto simp add: get_parent_locs_def set_disconnected_nodes_locs_def
      set_disconnected_nodes_get_host get_ancestors_si_locs_def all_args_def)
end

locale l_set_disconnected_nodes_get_ancestors_si =
  l_set_disconnected_nodes_defs +
  l_get_ancestors_si_defs +
  assumes set_disconnected_nodes_get_ancestors_si:
    "∀w ∈ set_disconnected_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_ancestors_si_locs. r h h'))"

interpretation i_set_disconnected_nodes_get_ancestors_si?:
  l_set_disconnected_nodes_get_ancestors_siCore_DOM set_disconnected_nodes set_disconnected_nodes_locs
  get_parent get_parent_locs type_wf known_ptr known_ptrs get_child_nodes get_child_nodes_locs
  get_host get_host_locs get_ancestors_si get_ancestors_si_locs get_root_node_si
  get_root_node_si_locs DocumentClass.type_wf

  by (auto simp add: l_set_disconnected_nodes_get_ancestors_siCore_DOM_def instances)
declare l_set_disconnected_nodes_get_ancestors_siCore_DOM_axioms[instances]


lemma set_disconnected_nodes_get_ancestors_si_is_l_set_disconnected_nodes_get_ancestors_si [instances]:
  "l_set_disconnected_nodes_get_ancestors_si set_disconnected_nodes_locs get_ancestors_si_locs"
  using instances
  apply(simp add: l_set_disconnected_nodes_get_ancestors_si_def)
  using set_disconnected_nodes_get_ancestors_si
  by fast



subsubsection ‹get\_attribute›

lemma get_attribute_is_l_get_attribute [instances]:
  "l_get_attribute type_wf get_attribute get_attribute_locs"
  apply(auto simp add: l_get_attribute_def)[1]
  using i_get_attribute.get_attribute_reads apply fast
  using type_wfDocument i_get_attribute.get_attribute_ok apply blast
  using i_get_attribute.get_attribute_ptr_in_heap apply fast
  done



subsubsection ‹to\_tree\_order›

global_interpretation l_to_tree_orderCore_DOM_defs get_child_nodes get_child_nodes_locs defines
  to_tree_order = "l_to_tree_orderCore_DOM_defs.a_to_tree_order get_child_nodes" .
declare a_to_tree_order.simps [code]

interpretation i_to_tree_order?: l_to_tree_orderCore_DOM ShadowRootClass.known_ptr
  ShadowRootClass.type_wf Shadow_DOM.get_child_nodes Shadow_DOM.get_child_nodes_locs to_tree_order
  by(auto simp add: l_to_tree_orderCore_DOM_def l_to_tree_orderCore_DOM_axioms_def to_tree_order_def
      instances)
declare l_to_tree_orderCore_DOM_axioms [instances]



subsubsection ‹to\_tree\_order\_si›


locale l_to_tree_order_siCore_DOM_defs =
  l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
  for get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
partial_function (dom_prog) a_to_tree_order_si :: "(_) object_ptr ⇒ (_, (_) object_ptr list) dom_prog"
  where
    "a_to_tree_order_si ptr = (do {
      children ← get_child_nodes ptr;
      shadow_root_part ← (case cast ptr of
        Some element_ptr ⇒ do {
          shadow_root_opt ← get_shadow_root element_ptr;
          (case shadow_root_opt of
            Some shadow_root_ptr ⇒ return [cast shadow_root_ptr]
            | None ⇒ return [])
        } |
        None ⇒ return []);
      treeorders ← map_M a_to_tree_order_si ((map (cast) children) @ shadow_root_part);
      return (ptr # concat treeorders)
    })"
end

locale l_to_tree_order_si_defs =
  fixes to_tree_order_si :: "(_) object_ptr ⇒ (_, (_) object_ptr list) dom_prog"

global_interpretation l_to_tree_order_siCore_DOM_defs get_child_nodes get_child_nodes_locs
  get_shadow_root get_shadow_root_locs
  defines to_tree_order_si = "a_to_tree_order_si" .
declare a_to_tree_order_si.simps [code]


locale l_to_tree_order_siShadow_DOM =
  l_to_tree_order_si_defs +
  l_to_tree_order_siCore_DOM_defs +
  l_get_child_nodes +
  l_get_shadow_root +
  assumes to_tree_order_si_impl: "to_tree_order_si = a_to_tree_order_si"
begin
lemmas to_tree_order_si_def = a_to_tree_order_si.simps[folded to_tree_order_si_impl]

lemma to_tree_order_si_pure [simp]: "pure (to_tree_order_si ptr) h"
proof -
  have "∀ptr h h' x. h ⊢ to_tree_order_si ptr →r x ⟶ h ⊢ to_tree_order_si ptr →h h' ⟶ h = h'"
  proof (induct rule: a_to_tree_order_si.fixp_induct[folded to_tree_order_si_impl])
    case 1
    then show ?case
      by (rule admissible_dom_prog)
  next
    case 2
    then show ?case
      by simp
  next
    case (3 f)
    then have "⋀x h. pure (f x) h"
      by (metis is_OK_returns_heap_E is_OK_returns_result_E pure_def)
    then have "⋀xs h. pure (map_M f xs) h"
      by(rule map_M_pure_I)
    then show ?case
      by(auto elim!: bind_returns_heap_E2 split: option.splits)
  qed
  then show ?thesis
    unfolding pure_def
    by (metis is_OK_returns_heap_E is_OK_returns_result_E)
qed
end

interpretation i_to_tree_order_si?: l_to_tree_order_siShadow_DOM to_tree_order_si get_child_nodes
  get_child_nodes_locs get_shadow_root get_shadow_root_locs type_wf known_ptr
  by(auto simp add: l_to_tree_order_siShadow_DOM_def l_to_tree_order_siShadow_DOM_axioms_def
      to_tree_order_si_def instances)
declare l_to_tree_order_siShadow_DOM_axioms [instances]


subsubsection ‹first\_in\_tree\_order›

global_interpretation l_first_in_tree_orderCore_DOM_defs to_tree_order defines
  first_in_tree_order = "l_first_in_tree_orderCore_DOM_defs.a_first_in_tree_order to_tree_order" .

interpretation i_first_in_tree_order?: l_first_in_tree_orderCore_DOM to_tree_order first_in_tree_order
  by(auto simp add: l_first_in_tree_orderCore_DOM_def first_in_tree_order_def)
declare l_first_in_tree_orderCore_DOM_axioms [instances]

lemma to_tree_order_is_l_to_tree_order [instances]: "l_to_tree_order to_tree_order"
  by(auto simp add: l_to_tree_order_def)



subsubsection ‹first\_in\_tree\_order›

global_interpretation l_dummy defines
  first_in_tree_order_si = "l_first_in_tree_orderCore_DOM_defs.a_first_in_tree_order to_tree_order_si"
  .


subsubsection ‹get\_element\_by›

global_interpretation l_get_element_byCore_DOM_defs to_tree_order first_in_tree_order get_attribute
  get_attribute_locs
  defines
    get_element_by_id =
    "l_get_element_byCore_DOM_defs.a_get_element_by_id first_in_tree_order get_attribute" and
    get_elements_by_class_name =
    "l_get_element_byCore_DOM_defs.a_get_elements_by_class_name to_tree_order get_attribute" and
    get_elements_by_tag_name =
    "l_get_element_byCore_DOM_defs.a_get_elements_by_tag_name to_tree_order" .

interpretation i_get_element_by?: l_get_element_byCore_DOM to_tree_order first_in_tree_order
  get_attribute get_attribute_locs get_element_by_id get_elements_by_class_name
  get_elements_by_tag_name type_wf
  by(auto simp add: l_get_element_byCore_DOM_def l_get_element_byCore_DOM_axioms_def
      get_element_by_id_def get_elements_by_class_name_def get_elements_by_tag_name_def
      instances)
declare l_get_element_byCore_DOM_axioms[instances]


lemma get_element_by_is_l_get_element_by [instances]:
  "l_get_element_by get_element_by_id get_elements_by_tag_name to_tree_order"
  apply(auto simp add: l_get_element_by_def)[1]
  using get_element_by_id_result_in_tree_order apply fast
  done


subsubsection ‹get\_element\_by\_si›

global_interpretation l_dummy defines
  get_element_by_id_si =
  "l_get_element_byCore_DOM_defs.a_get_element_by_id first_in_tree_order_si get_attribute" and
  get_elements_by_class_name_si =
  "l_get_element_byCore_DOM_defs.a_get_elements_by_class_name to_tree_order_si get_attribute" and
  get_elements_by_tag_name_si =
  "l_get_element_byCore_DOM_defs.a_get_elements_by_tag_name to_tree_order_si"
  .



subsubsection ‹find\_slot›

locale l_find_slotShadow_DOM_defs =
  l_get_parent_defs get_parent get_parent_locs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
  l_get_mode_defs get_mode get_mode_locs +
  l_get_attribute_defs get_attribute get_attribute_locs +
  l_get_tag_name_defs get_tag_name get_tag_name_locs +
  l_first_in_tree_order_defs first_in_tree_order
  for get_parent :: "(_) node_ptr ⇒ ((_) heap, exception, (_::linorder) object_ptr option) prog"
    and get_parent_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_mode :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, shadow_root_mode) prog"
    and get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_attribute :: "(_) element_ptr ⇒ char list ⇒ ((_) heap, exception, char list option) prog"
    and get_attribute_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and first_in_tree_order ::
    "(_) object_ptr ⇒ ((_) object_ptr ⇒ ((_) heap, exception, (_) element_ptr option) prog) ⇒
    ((_) heap, exception, (_) element_ptr option) prog"
begin
definition a_find_slot :: "bool ⇒ (_) node_ptr ⇒ (_, (_) element_ptr option) dom_prog"
  where
    "a_find_slot open_flag slotable = do {
      parent_opt ← get_parent slotable;
      (case parent_opt of
        Some parent ⇒
          if is_element_ptr_kind parent
          then do {
            shadow_root_ptr_opt ← get_shadow_root (the (cast parent));
            (case shadow_root_ptr_opt of
              Some shadow_root_ptr ⇒ do {
                shadow_root_mode ← get_mode shadow_root_ptr;
                if open_flag ∧ shadow_root_mode ≠ Open
                then return None
                else first_in_tree_order (cast shadow_root_ptr) (λptr. if is_element_ptr_kind ptr
                  then do {
                    tag ← get_tag_name (the (cast ptr));
                    name_attr ← get_attribute (the (cast ptr)) ''name'';
                    slotable_name_attr ← (if is_element_ptr_kind slotable
                                           then get_attribute (the (cast slotable)) ''slot''
                                           else return None);
                    (if (tag = ''slot'' ∧ (name_attr = slotable_name_attr ∨
                        (name_attr = None ∧ slotable_name_attr = Some '''') ∨
                        (name_attr = Some '''' ∧ slotable_name_attr = None)))
                    then return (Some (the (cast ptr)))
                    else return None)}
                  else return None)}
              | None ⇒ return None)}
          else return None
    | _ ⇒ return None)}"

definition a_assigned_slot :: "(_) node_ptr ⇒ (_, (_) element_ptr option) dom_prog"
  where
    "a_assigned_slot = a_find_slot True"
end

global_interpretation l_find_slotShadow_DOM_defs get_parent get_parent_locs get_shadow_root
  get_shadow_root_locs get_mode get_mode_locs get_attribute get_attribute_locs get_tag_name
  get_tag_name_locs first_in_tree_order
  defines find_slot = a_find_slot
    and assigned_slot = a_assigned_slot
  .

locale l_find_slot_defs =
  fixes find_slot :: "bool ⇒ (_) node_ptr ⇒ (_, (_) element_ptr option) dom_prog"
    and assigned_slot :: "(_) node_ptr ⇒ (_, (_) element_ptr option) dom_prog"

locale l_find_slotShadow_DOM =
  l_find_slotShadow_DOM_defs +
  l_find_slot_defs +
  l_get_parent +
  l_get_shadow_root +
  l_get_mode +
  l_get_attribute +
  l_get_tag_name +
  l_to_tree_order +
  l_first_in_tree_orderCore_DOM +
  assumes find_slot_impl: "find_slot = a_find_slot"
  assumes assigned_slot_impl: "assigned_slot = a_assigned_slot"
begin
lemmas find_slot_def = find_slot_impl[unfolded a_find_slot_def]
lemmas assigned_slot_def = assigned_slot_impl[unfolded a_assigned_slot_def]

lemma find_slot_ptr_in_heap:
  assumes "h ⊢ find_slot open_flag slotable →r slot_opt"
  shows "slotable |∈| node_ptr_kinds h"
  using assms
  apply(auto simp add: find_slot_def elim!: bind_returns_result_E2)[1]
  using get_parent_ptr_in_heap by blast

lemma find_slot_slot_in_heap:
  assumes "h ⊢ find_slot open_flag slotable →r Some slot"
  shows "slot |∈| element_ptr_kinds h"
  using assms
  apply(auto simp add: find_slot_def first_in_tree_order_def
      elim!: bind_returns_result_E2 map_filter_M_pure_E[where y=slot]
      split: option.splits if_splits list.splits
      intro!: map_filter_M_pure bind_pure_I)[1]
  using get_tag_name_ptr_in_heap by blast+

lemma find_slot_pure [simp]: "pure (find_slot open_flag slotable) h"
  by(auto simp add: find_slot_def first_in_tree_order_def
      intro!: bind_pure_I map_filter_M_pure
      split: option.splits list.splits)
end

interpretation i_find_slot?: l_find_slotShadow_DOM get_parent get_parent_locs get_shadow_root
  get_shadow_root_locs get_mode get_mode_locs get_attribute get_attribute_locs get_tag_name
  get_tag_name_locs first_in_tree_order find_slot assigned_slot type_wf known_ptr known_ptrs
  get_child_nodes get_child_nodes_locs to_tree_order
  by (auto simp add: find_slot_def assigned_slot_def l_find_slotShadow_DOM_def
      l_find_slotShadow_DOM_axioms_def instances)
declare l_find_slotShadow_DOM_axioms [instances]

locale l_find_slot = l_find_slot_defs +
  assumes find_slot_ptr_in_heap:
    "h ⊢ find_slot open_flag slotable →r slot_opt ⟹ slotable |∈| node_ptr_kinds h"
  assumes find_slot_slot_in_heap:
    "h ⊢ find_slot open_flag slotable →r Some slot ⟹ slot |∈| element_ptr_kinds h"
  assumes find_slot_pure [simp]:
    "pure (find_slot open_flag slotable) h"

lemma find_slot_is_l_find_slot [instances]: "l_find_slot find_slot"
  apply(auto simp add: l_find_slot_def)[1]
  using find_slot_ptr_in_heap apply fast
  using find_slot_slot_in_heap apply fast
  done



subsubsection ‹get\_disconnected\_nodes›

locale l_get_disconnected_nodesShadow_DOM =
  CD: l_get_disconnected_nodesCore_DOM type_wfCore_DOM get_disconnected_nodes
  get_disconnected_nodes_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ (_, (_) node_ptr list) dom_prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
begin

lemma get_disconnected_nodes_ok:
  "type_wf h ⟹ document_ptr |∈| document_ptr_kinds h ⟹
    h ⊢ ok (get_disconnected_nodes document_ptr)"
  apply(unfold type_wf_impl get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def])
  using CD.get_disconnected_nodes_ok CD.type_wf_impl ShadowRootClass.type_wfDocument
  by blast
end

interpretation i_get_disconnected_nodes?: l_get_disconnected_nodesShadow_DOM type_wf
  DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
  by(auto simp add: l_get_disconnected_nodesShadow_DOM_def l_get_disconnected_nodesShadow_DOM_axioms_def
      instances)
declare l_get_disconnected_nodesShadow_DOM_axioms [instances]

lemma get_disconnected_nodes_is_l_get_disconnected_nodes [instances]:
  "l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs"
  apply(auto simp add: l_get_disconnected_nodes_def)[1]
  using i_get_disconnected_nodes.get_disconnected_nodes_reads apply fast
  using get_disconnected_nodes_ok apply fast
  using i_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap apply fast
  done


paragraph ‹set\_child\_nodes›

locale l_set_child_nodes_get_disconnected_nodesShadow_DOM =
  l_set_child_nodesShadow_DOM +
  l_get_disconnected_nodesShadow_DOM
begin
lemma set_child_nodes_get_disconnected_nodes:
  "∀w ∈ set_child_nodes_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"
  by(auto simp add: set_child_nodes_locs_def CD.set_child_nodes_locs_def
      CD.get_disconnected_nodes_locs_def all_args_def)
end

interpretation
  i_set_child_nodes_get_disconnected_nodes?: l_set_child_nodes_get_disconnected_nodesShadow_DOM type_wf
  known_ptr DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
  Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs
  get_disconnected_nodes get_disconnected_nodes_locs
  apply(auto simp add: l_set_child_nodes_get_disconnected_nodesShadow_DOM_def instances)[1]
  by(unfold_locales)
declare l_set_child_nodes_get_disconnected_nodesShadow_DOM_axioms[instances]

lemma set_child_nodes_get_disconnected_nodes_is_l_set_child_nodes_get_disconnected_nodes [instances]:
  "l_set_child_nodes_get_disconnected_nodes type_wf set_child_nodes set_child_nodes_locs
    get_disconnected_nodes get_disconnected_nodes_locs"
  using set_child_nodes_is_l_set_child_nodes get_disconnected_nodes_is_l_get_disconnected_nodes
  apply(simp add: l_set_child_nodes_get_disconnected_nodes_def
      l_set_child_nodes_get_disconnected_nodes_axioms_def)
  using set_child_nodes_get_disconnected_nodes
  by fast


paragraph ‹set\_disconnected\_nodes›

lemma set_disconnected_nodes_get_disconnected_nodes_l_set_disconnected_nodes_get_disconnected_nodes
  [instances]:
  "l_set_disconnected_nodes_get_disconnected_nodes ShadowRootClass.type_wf get_disconnected_nodes
    get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_def
      l_set_disconnected_nodes_get_disconnected_nodes_axioms_def instances)[1]
  using i_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
   apply fast
  using i_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes_different_pointers
  apply fast
  done


paragraph ‹delete\_shadow\_root›

locale l_delete_shadow_root_get_disconnected_nodesShadow_DOM =
  l_get_disconnected_nodesShadow_DOM
begin
lemma get_disconnected_nodes_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_disconnected_nodes_locs ptr' ⟹ r h h'"
  by(auto simp add: CD.get_disconnected_nodes_locs_def delete_shadow_root_get_MDocument)
end

locale l_delete_shadow_root_get_disconnected_nodes = l_get_disconnected_nodes_defs +
  assumes get_disconnected_nodes_delete_shadow_root:  "h ⊢ deleteShadowRoot_M shadow_root_ptr →h h'
    ⟹ r ∈ get_disconnected_nodes_locs ptr' ⟹ r h h'"
interpretation l_delete_shadow_root_get_disconnected_nodesShadow_DOM type_wf DocumentClass.type_wf
  get_disconnected_nodes get_disconnected_nodes_locs
  by(auto simp add: l_delete_shadow_root_get_disconnected_nodesShadow_DOM_def instances)

lemma l_delete_shadow_root_get_disconnected_nodes_get_disconnected_nodes_locs [instances]: "l_delete_shadow_root_get_disconnected_nodes get_disconnected_nodes_locs"
  apply(auto simp add: l_delete_shadow_root_get_disconnected_nodes_def)[1]
  using get_disconnected_nodes_delete_shadow_root apply fast
  done


paragraph ‹set\_shadow\_root›

locale l_set_shadow_root_get_disconnected_nodesShadow_DOM =
  l_set_shadow_rootShadow_DOM +
  l_get_disconnected_nodesShadow_DOM
begin
lemma set_shadow_root_get_disconnected_nodes:
  "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"
  by(auto simp add: set_shadow_root_locs_def CD.get_disconnected_nodes_locs_def all_args_def)
end

interpretation i_set_shadow_root_get_disconnected_nodes?:
  l_set_shadow_root_get_disconnected_nodesShadow_DOM type_wf set_shadow_root set_shadow_root_locs
  DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
  apply(auto simp add: l_set_shadow_root_get_disconnected_nodesShadow_DOM_def instances)[1]
  by(unfold_locales)
declare l_set_shadow_root_get_disconnected_nodesShadow_DOM_axioms[instances]

locale l_set_shadow_root_get_disconnected_nodes =
  l_set_shadow_root_defs +
  l_get_disconnected_nodes_defs +
  assumes set_shadow_root_get_disconnected_nodes:
    "∀w ∈ set_shadow_root_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"

lemma set_shadow_root_get_disconnected_nodes_is_l_set_shadow_root_get_disconnected_nodes [instances]:
  "l_set_shadow_root_get_disconnected_nodes set_shadow_root_locs get_disconnected_nodes_locs"
  using set_shadow_root_is_l_set_shadow_root get_disconnected_nodes_is_l_get_disconnected_nodes
  apply(simp add: l_set_shadow_root_get_disconnected_nodes_def )
  using set_shadow_root_get_disconnected_nodes
  by fast


paragraph ‹set\_mode›

locale l_set_mode_get_disconnected_nodesShadow_DOM =
  l_set_modeShadow_DOM +
  l_get_disconnected_nodesShadow_DOM
begin
lemma set_mode_get_disconnected_nodes:
  "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"
  by(auto simp add: set_mode_locs_def
      CD.get_disconnected_nodes_locs_impl[unfolded CD.a_get_disconnected_nodes_locs_def]
      all_args_def)
end

interpretation i_set_mode_get_disconnected_nodes?: l_set_mode_get_disconnected_nodesShadow_DOM type_wf
  set_mode set_mode_locs DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
  by unfold_locales
declare l_set_mode_get_disconnected_nodesShadow_DOM_axioms[instances]

locale l_set_mode_get_disconnected_nodes = l_set_mode + l_get_disconnected_nodes +
  assumes set_mode_get_disconnected_nodes:
    "∀w ∈ set_mode_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"

lemma set_mode_get_disconnected_nodes_is_l_set_mode_get_disconnected_nodes [instances]:
  "l_set_mode_get_disconnected_nodes type_wf set_mode set_mode_locs get_disconnected_nodes
                                         get_disconnected_nodes_locs"
  using set_mode_is_l_set_mode get_disconnected_nodes_is_l_get_disconnected_nodes
  apply(simp add: l_set_mode_get_disconnected_nodes_def
      l_set_mode_get_disconnected_nodes_axioms_def)
  using set_mode_get_disconnected_nodes
  by fast

paragraph ‹new\_shadow\_root›

locale l_new_shadow_root_get_disconnected_nodesShadow_DOM =
  l_get_disconnected_nodesShadow_DOM type_wf type_wfCore_DOM get_disconnected_nodes
  get_disconnected_nodes_locs
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ (_, (_) node_ptr list) dom_prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
lemma get_disconnected_nodes_new_shadow_root:
  "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
    ⟹ r ∈ get_disconnected_nodes_locs ptr' ⟹ r h h'"
  by(auto simp add: CD.get_disconnected_nodes_locs_def new_shadow_root_get_MDocument)
end

interpretation i_new_shadow_root_get_disconnected_nodes?:
  l_new_shadow_root_get_disconnected_nodesShadow_DOM type_wf DocumentClass.type_wf
  get_disconnected_nodes get_disconnected_nodes_locs
  by unfold_locales
declare l_new_shadow_root_get_disconnected_nodesShadow_DOM_axioms[instances]

locale l_new_shadow_root_get_disconnected_nodes = l_get_disconnected_nodes_defs +
  assumes get_disconnected_nodes_new_shadow_root:
    "h ⊢ newShadowRoot_M →r new_shadow_root_ptr ⟹ h ⊢ newShadowRoot_M →h h'
    ⟹ r ∈ get_disconnected_nodes_locs ptr' ⟹ r h h'"

lemma new_shadow_root_get_disconnected_nodes_is_l_new_shadow_root_get_disconnected_nodes [instances]:
  "l_new_shadow_root_get_disconnected_nodes get_disconnected_nodes_locs"
  apply (auto simp add: l_new_shadow_root_get_disconnected_nodes_def)[1]
  using get_disconnected_nodes_new_shadow_root apply fast
  done


subsubsection ‹remove\_shadow\_root›

locale l_remove_shadow_rootShadow_DOM_defs =
  l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
  l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
  l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs
  for get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and set_shadow_root ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ ((_) heap, exception, unit) prog"
    and set_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin

definition a_remove_shadow_root :: "(_) element_ptr ⇒ (_, unit) dom_prog" where
  "a_remove_shadow_root element_ptr = do {
    shadow_root_ptr_opt ← get_shadow_root element_ptr;
    (case shadow_root_ptr_opt of
      Some shadow_root_ptr ⇒ do {
        children ← get_child_nodes (cast shadow_root_ptr);
        (if children = []
        then do {
          set_shadow_root element_ptr None;
          delete_M shadow_root_ptr
        } else do {
          error HierarchyRequestError
        })
      } |
      None ⇒ error HierarchyRequestError)
    }"

definition a_remove_shadow_root_locs ::
  "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_, unit) dom_prog) set"
  where
    "a_remove_shadow_root_locs element_ptr shadow_root_ptr ≡
      set_shadow_root_locs element_ptr ∪ {delete_M shadow_root_ptr}"
end

global_interpretation l_remove_shadow_rootShadow_DOM_defs get_child_nodes get_child_nodes_locs
  get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  defines remove_shadow_root = "a_remove_shadow_root"
    and remove_shadow_root_locs = a_remove_shadow_root_locs
  .

locale l_remove_shadow_root_defs =
  fixes remove_shadow_root :: "(_) element_ptr ⇒ (_, unit) dom_prog"
  fixes remove_shadow_root_locs ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_, unit) dom_prog) set"


locale l_remove_shadow_rootShadow_DOM =
  l_remove_shadow_rootShadow_DOM_defs +
  l_remove_shadow_root_defs +
  l_get_shadow_rootShadow_DOM +
  l_set_shadow_rootShadow_DOM +
  l_get_child_nodes +
  l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
  assumes remove_shadow_root_impl: "remove_shadow_root = a_remove_shadow_root"
  assumes remove_shadow_root_locs_impl: "remove_shadow_root_locs = a_remove_shadow_root_locs"
begin
lemmas remove_shadow_root_def =
  remove_shadow_root_impl[unfolded remove_shadow_root_def a_remove_shadow_root_def]
lemmas remove_shadow_root_locs_def =
  remove_shadow_root_locs_impl[unfolded remove_shadow_root_locs_def a_remove_shadow_root_locs_def]

lemma remove_shadow_root_writes:
  "writes (remove_shadow_root_locs element_ptr (the |h ⊢ get_shadow_root element_ptr|r))
    (remove_shadow_root element_ptr) h h'"
  apply(auto simp add: remove_shadow_root_locs_def remove_shadow_root_def all_args_def
      writes_union_right_I writes_union_left_I set_shadow_root_writes
      intro!: writes_bind writes_bind_pure[OF get_shadow_root_pure]
      writes_bind_pure[OF get_child_nodes_pure]
      intro: writes_subset[OF set_shadow_root_writes] writes_subset[OF writes_singleton2]
      split: option.splits)[1]
  using  writes_union_left_I[OF set_shadow_root_writes]
   apply (metis inf_sup_aci(5) insert_is_Un)
  using writes_union_right_I[OF writes_singleton[of deleteShadowRoot_M]]
  by (smt (verit, best) insert_is_Un writes_singleton2 writes_union_left_I)
end

interpretation i_remove_shadow_root?: l_remove_shadow_rootShadow_DOM get_child_nodes
  get_child_nodes_locs get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs
  get_disconnected_nodes get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs
  type_wf known_ptr
  by(auto simp add: l_remove_shadow_rootShadow_DOM_def l_remove_shadow_rootShadow_DOM_axioms_def
      remove_shadow_root_def remove_shadow_root_locs_def instances)
declare l_remove_shadow_rootShadow_DOM_axioms [instances]


paragraph ‹get\_child\_nodes›

locale l_remove_shadow_root_get_child_nodesShadow_DOM =
  l_get_child_nodesShadow_DOM +
  l_remove_shadow_rootShadow_DOM
begin

lemma remove_shadow_root_get_child_nodes_different_pointers:
  assumes "ptr ≠ cast shadow_root_ptr"
  assumes "w ∈ remove_shadow_root_locs element_ptr shadow_root_ptr"
  assumes "h ⊢ w →h h'"
  assumes "r ∈ get_child_nodes_locs ptr"
  shows "r h h'"
  using assms
  apply(auto simp add: all_args_def get_child_nodes_locs_def CD.get_child_nodes_locs_def
      remove_shadow_root_locs_def set_shadow_root_locs_def
      delete_shadow_root_get_MObject delete_shadow_root_get_MShadowRoot
      delete_shadow_root_get_MShadowRoot delete_shadow_root_get_MElement
      delete_shadow_root_get_MDocument[rotated]
      element_put_get_preserved[where setter=shadow_root_opt_update]
      intro: is_shadow_root_ptr_kind_obtains
      elim: is_document_ptr_kind_obtains is_shadow_root_ptr_kind_obtains
      split: if_splits option.splits)[1]
  done
end

locale l_remove_shadow_root_get_child_nodes = l_get_child_nodes_defs + l_remove_shadow_root_defs +
  assumes remove_shadow_root_get_child_nodes_different_pointers:
    "ptr ≠ cast shadow_root_ptr ⟹ w ∈ remove_shadow_root_locs element_ptr shadow_root_ptr ⟹
      h ⊢ w →h h' ⟹ r ∈ get_child_nodes_locs ptr ⟹ r h h'"

interpretation i_remove_shadow_root_get_child_nodes?: l_remove_shadow_root_get_child_nodesShadow_DOM
  type_wf known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
  get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
  get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
  get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs
  by(auto simp add: l_remove_shadow_root_get_child_nodesShadow_DOM_def instances)
declare l_remove_shadow_root_get_child_nodesShadow_DOM_axioms[instances]

lemma remove_shadow_root_get_child_nodes_is_l_remove_shadow_root_get_child_nodes [instances]:
  "l_remove_shadow_root_get_child_nodes get_child_nodes_locs remove_shadow_root_locs"
  apply(auto simp add: l_remove_shadow_root_get_child_nodes_def instances )[1]
  using remove_shadow_root_get_child_nodes_different_pointers apply fast
  done

paragraph ‹get\_tag\_name›

locale l_remove_shadow_root_get_tag_nameShadow_DOM =
  l_get_tag_nameShadow_DOM +
  l_remove_shadow_rootShadow_DOM
begin

lemma remove_shadow_root_get_tag_name:
  assumes "w ∈ remove_shadow_root_locs element_ptr shadow_root_ptr"
  assumes "h ⊢ w →h h'"
  assumes "r ∈ get_tag_name_locs ptr"
  shows "r h h'"
  using assms
  by(auto simp add: all_args_def remove_shadow_root_locs_def set_shadow_root_locs_def
      CD.get_tag_name_locs_def delete_shadow_root_get_MElement
      element_put_get_preserved[where setter=shadow_root_opt_update]
      split: if_splits option.splits)
end

locale l_remove_shadow_root_get_tag_name = l_get_tag_name_defs + l_remove_shadow_root_defs +
  assumes remove_shadow_root_get_tag_name:
    "w ∈ remove_shadow_root_locs element_ptr shadow_root_ptr ⟹ h ⊢ w →h h' ⟹
    r ∈ get_tag_name_locs ptr ⟹ r h h'"

interpretation i_remove_shadow_root_get_tag_name?: l_remove_shadow_root_get_tag_nameShadow_DOM type_wf
  DocumentClass.type_wf get_tag_name get_tag_name_locs get_child_nodes get_child_nodes_locs
  get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
  get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs known_ptr
  by(auto simp add: l_remove_shadow_root_get_tag_nameShadow_DOM_def instances)
declare l_remove_shadow_root_get_tag_nameShadow_DOM_axioms[instances]

lemma remove_shadow_root_get_tag_name_is_l_remove_shadow_root_get_tag_name [instances]:
  "l_remove_shadow_root_get_tag_name get_tag_name_locs remove_shadow_root_locs"
  apply(auto simp add: l_remove_shadow_root_get_tag_name_def instances )[1]
  using remove_shadow_root_get_tag_name apply fast
  done


subsubsection ‹get\_owner\_document›

locale l_get_owner_documentShadow_DOM_defs =
  l_get_host_defs get_host get_host_locs +
  CD: l_get_owner_documentCore_DOM_defs get_root_node get_root_node_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  for get_root_node :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) object_ptr) prog"
    and get_root_node_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_get_owner_documentshadow_root_ptr ::
  "(_) shadow_root_ptr ⇒ unit ⇒ (_, (_) document_ptr) dom_prog"
  where
    "a_get_owner_documentshadow_root_ptr shadow_root_ptr _ = do {
      host ← get_host shadow_root_ptr;
      CD.a_get_owner_documentnode_ptr (cast host) ()
    }"

definition a_get_owner_document_tups :: "(((_) object_ptr ⇒ bool) × ((_) object_ptr ⇒ unit
  ⇒ (_, (_) document_ptr) dom_prog)) list"
  where
    "a_get_owner_document_tups = [(is_shadow_root_ptr, a_get_owner_documentshadow_root_ptr ∘ the ∘ cast)]"

definition a_get_owner_document :: "(_::linorder) object_ptr ⇒ (_, (_) document_ptr) dom_prog"
  where
    "a_get_owner_document ptr = invoke (CD.a_get_owner_document_tups @ a_get_owner_document_tups) ptr ()"
end

global_interpretation l_get_owner_documentShadow_DOM_defs get_root_node_si get_root_node_si_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_host get_host_locs
  defines get_owner_document_tups = a_get_owner_document_tups
    and get_owner_document = a_get_owner_document
    and get_owner_documentshadow_root_ptr = a_get_owner_documentshadow_root_ptr
    and get_owner_document_tupsCore_DOM =
      "l_get_owner_documentCore_DOM_defs.a_get_owner_document_tups
        get_root_node_si get_disconnected_nodes"
    and get_owner_documentnode_ptr =
      "l_get_owner_documentCore_DOM_defs.a_get_owner_documentnode_ptr
        get_root_node_si get_disconnected_nodes"
  .

locale l_get_owner_documentShadow_DOM =
  l_known_ptr known_ptr +
  l_get_owner_documentShadow_DOM_defs get_root_node_si get_root_node_si_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_host get_host_locs +
  l_get_owner_document_defs get_owner_document +
  l_get_host get_host get_host_locs +
  CD: l_get_owner_documentCore_DOM
  get_parent get_parent_locs known_ptrCore_DOM type_wf get_disconnected_nodes
  get_disconnected_nodes_locs get_root_node_si get_root_node_si_locs get_owner_documentCore_DOM
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and known_ptrCore_DOM :: "(_::linorder) object_ptr ⇒ bool"
    and get_parent :: "(_) node_ptr ⇒ ((_) heap, exception, (_) object_ptr option) prog"
    and get_parent_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and type_wf :: "(_) heap ⇒ bool"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_root_node_si :: "(_) object_ptr ⇒ ((_) heap, exception, (_) object_ptr) prog"
    and get_root_node_si_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_owner_documentCore_DOM :: "(_) object_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_owner_document :: "(_) object_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog" +
  assumes known_ptr_impl: "known_ptr = a_known_ptr"
  assumes get_owner_document_impl: "get_owner_document = a_get_owner_document"
begin
lemmas known_ptr_def = known_ptr_impl[unfolded a_known_ptr_def]
lemmas get_owner_document_def = a_get_owner_document_def[folded get_owner_document_impl]

lemma get_owner_document_pure [simp]:
  "pure (get_owner_document ptr) h"
proof -
  have "⋀shadow_root_ptr. pure (a_get_owner_documentshadow_root_ptr shadow_root_ptr ()) h"
    apply(auto simp add: a_get_owner_documentshadow_root_ptr_def
        intro!: bind_pure_I filter_M_pure_I
        split: option.splits)[1]
    by(auto simp add: CD.a_get_owner_documentnode_ptr_def
        intro!: bind_pure_I filter_M_pure_I
        split: option.splits)
  then show ?thesis
    apply(auto simp add: get_owner_document_def)[1]
    apply(split CD.get_owner_document_splits, rule conjI)+
     apply(simp)
    apply(auto simp add: a_get_owner_document_tups_def)[1]
    apply(split invoke_splits, rule conjI)+
     apply simp
    by(auto intro!: bind_pure_I)
qed

lemma get_owner_document_ptr_in_heap:
  assumes "h ⊢ ok (get_owner_document ptr)"
  shows "ptr |∈| object_ptr_kinds h"
  using assms
  by(auto simp add: get_owner_document_def invoke_ptr_in_heap dest: is_OK_returns_heap_I)

end

interpretation i_get_owner_document?: l_get_owner_documentShadow_DOM known_ptr DocumentClass.known_ptr
  get_parent get_parent_locs type_wf get_disconnected_nodes get_disconnected_nodes_locs
  get_root_node_si get_root_node_si_locs CD.a_get_owner_document get_host get_host_locs
  get_owner_document
  by(auto simp add: instances l_get_owner_documentShadow_DOM_def l_get_owner_documentShadow_DOM_axioms_def
      l_get_owner_documentCore_DOM_def l_get_owner_documentCore_DOM_axioms_def
      get_owner_document_def Core_DOM_Functions.get_owner_document_def)
declare l_get_owner_documentShadow_DOM_axioms [instances]

lemma get_owner_document_is_l_get_owner_document [instances]:
  "l_get_owner_document get_owner_document"
  apply(auto simp add: l_get_owner_document_def)[1]
  using get_owner_document_ptr_in_heap apply fast
  done




subsubsection ‹remove\_child›

global_interpretation l_remove_childCore_DOM_defs get_child_nodes get_child_nodes_locs set_child_nodes
  set_child_nodes_locs get_parent get_parent_locs get_owner_document get_disconnected_nodes
  get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs
  defines remove = "l_remove_childCore_DOM_defs.a_remove get_child_nodes set_child_nodes get_parent
    get_owner_document get_disconnected_nodes set_disconnected_nodes"
    and remove_child = "l_remove_childCore_DOM_defs.a_remove_child get_child_nodes set_child_nodes
    get_owner_document get_disconnected_nodes set_disconnected_nodes"
    and remove_child_locs = "l_remove_childCore_DOM_defs.a_remove_child_locs set_child_nodes_locs
    set_disconnected_nodes_locs"
  .

interpretation i_remove_child?: l_remove_childCore_DOM Shadow_DOM.get_child_nodes
  Shadow_DOM.get_child_nodes_locs Shadow_DOM.set_child_nodes Shadow_DOM.set_child_nodes_locs
  Shadow_DOM.get_parent Shadow_DOM.get_parent_locs Shadow_DOM.get_owner_document
  get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
  set_disconnected_nodes_locs remove_child remove_child_locs remove ShadowRootClass.type_wf
  ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
  by(auto simp add: l_remove_childCore_DOM_def l_remove_childCore_DOM_axioms_def remove_child_def
      remove_child_locs_def remove_def instances)
declare l_remove_childCore_DOM_axioms [instances]



subsubsection ‹get\_disconnected\_document›

locale l_get_disconnected_documentCore_DOM_defs =
  l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs
  for get_disconnected_nodes ::
    "(_::linorder) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_get_disconnected_document :: "(_) node_ptr ⇒ (_, (_) document_ptr) dom_prog"
  where
    "a_get_disconnected_document node_ptr = do {
      check_in_heap (cast node_ptr);
      ptrs ← document_ptr_kinds_M;
      candidates ← filter_M (λdocument_ptr. do {
        disconnected_nodes ← get_disconnected_nodes document_ptr;
        return (node_ptr ∈ set disconnected_nodes)
      }) ptrs;
      (case candidates of
        Cons document_ptr [] ⇒ return document_ptr |
        _ ⇒ error HierarchyRequestError
      )
    }"
definition "a_get_disconnected_document_locs =
  (⋃document_ptr. get_disconnected_nodes_locs document_ptr) ∪
  (⋃ptr. {preserved (get_MObject ptr RObject.nothing)})"
end

locale l_get_disconnected_document_defs =
  fixes get_disconnected_document :: "(_) node_ptr ⇒ (_, (_::linorder) document_ptr) dom_prog"
  fixes get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"

locale l_get_disconnected_documentCore_DOM =
  l_get_disconnected_documentCore_DOM_defs +
  l_get_disconnected_document_defs +
  l_get_disconnected_nodes +
  assumes get_disconnected_document_impl:
    "get_disconnected_document = a_get_disconnected_document"
  assumes get_disconnected_document_locs_impl:
    "get_disconnected_document_locs = a_get_disconnected_document_locs"
begin
lemmas get_disconnected_document_def =
  get_disconnected_document_impl[unfolded a_get_disconnected_document_def]
lemmas get_disconnected_document_locs_def =
  get_disconnected_document_locs_impl[unfolded a_get_disconnected_document_locs_def]


lemma get_disconnected_document_pure [simp]: "pure (get_disconnected_document ptr) h"
  using get_disconnected_nodes_pure
  by(auto simp add: get_disconnected_document_def
      intro!: bind_pure_I filter_M_pure_I
      split: list.splits)

lemma get_disconnected_document_ptr_in_heap [simp]:
  "h ⊢ ok (get_disconnected_document node_ptr) ⟹ node_ptr |∈| node_ptr_kinds h"
  using get_disconnected_document_def is_OK_returns_result_I check_in_heap_ptr_in_heap
  by (metis (no_types, lifting) bind_returns_heap_E get_disconnected_document_pure
      node_ptr_kinds_commutes pure_pure)

lemma get_disconnected_document_disconnected_document_in_heap:
  assumes "h ⊢ get_disconnected_document child_node →r disconnected_document"
  shows "disconnected_document |∈| document_ptr_kinds h"
  using assms get_disconnected_nodes_pure
  by(auto simp add: get_disconnected_document_def elim!: bind_returns_result_E2
      dest!: filter_M_not_more_elements[where x=disconnected_document]
      intro!: filter_M_pure_I bind_pure_I
      split: if_splits list.splits)

lemma get_disconnected_document_reads:
  "reads get_disconnected_document_locs (get_disconnected_document node_ptr) h h'"
  using get_disconnected_nodes_reads[unfolded reads_def]
  by(auto simp add: get_disconnected_document_def get_disconnected_document_locs_def
      intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
      reads_subset[OF error_reads]
      reads_subset[OF get_disconnected_nodes_reads] reads_subset[OF return_reads]
      reads_subset[OF document_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I
      bind_pure_I
      split: list.splits)

end

locale l_get_disconnected_document = l_get_disconnected_document_defs +
  assumes get_disconnected_document_reads:
    "reads get_disconnected_document_locs (get_disconnected_document node_ptr) h h'"
  assumes get_disconnected_document_ptr_in_heap:
    "h ⊢ ok (get_disconnected_document node_ptr) ⟹ node_ptr |∈| node_ptr_kinds h"
  assumes get_disconnected_document_pure [simp]:
    "pure (get_disconnected_document node_ptr) h"
  assumes get_disconnected_document_disconnected_document_in_heap:
    "h ⊢ get_disconnected_document child_node →r disconnected_document ⟹
    disconnected_document |∈| document_ptr_kinds h"

global_interpretation l_get_disconnected_documentCore_DOM_defs get_disconnected_nodes
  get_disconnected_nodes_locs defines
  get_disconnected_document = a_get_disconnected_document and
  get_disconnected_document_locs = a_get_disconnected_document_locs .

interpretation i_get_disconnected_document?: l_get_disconnected_documentCore_DOM
  get_disconnected_nodes get_disconnected_nodes_locs get_disconnected_document
  get_disconnected_document_locs type_wf
  by(auto simp add: l_get_disconnected_documentCore_DOM_def l_get_disconnected_documentCore_DOM_axioms_def
      get_disconnected_document_def get_disconnected_document_locs_def instances)
declare l_get_disconnected_documentCore_DOM_axioms [instances]

lemma get_disconnected_document_is_l_get_disconnected_document [instances]:
  "l_get_disconnected_document get_disconnected_document get_disconnected_document_locs"
  apply(auto simp add: l_get_disconnected_document_def instances)[1]
  using get_disconnected_document_ptr_in_heap get_disconnected_document_pure
    get_disconnected_document_disconnected_document_in_heap get_disconnected_document_reads
  by blast+

paragraph ‹get\_disconnected\_nodes›

locale l_set_tag_name_get_disconnected_nodesShadow_DOM =
  l_set_tag_nameShadow_DOM +
  l_get_disconnected_nodesShadow_DOM
begin
lemma set_tag_name_get_disconnected_nodes:
  "∀w ∈ set_tag_name_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_disconnected_nodes_locs ptr'. r h h'))"
  by(auto simp add: CD.set_tag_name_locs_impl[unfolded CD.a_set_tag_name_locs_def]
      CD.get_disconnected_nodes_locs_impl[unfolded CD.a_get_disconnected_nodes_locs_def]
      all_args_def)
end

interpretation
  i_set_tag_name_get_disconnected_nodes?: l_set_tag_name_get_disconnected_nodesShadow_DOM type_wf
  DocumentClass.type_wf set_tag_name set_tag_name_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  by unfold_locales
declare l_set_tag_name_get_disconnected_nodesCore_DOM_axioms[instances]

lemma set_tag_name_get_disconnected_nodes_is_l_set_tag_name_get_disconnected_nodes [instances]:
  "l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs
    get_disconnected_nodes get_disconnected_nodes_locs"
  using set_tag_name_is_l_set_tag_name get_disconnected_nodes_is_l_get_disconnected_nodes
  apply(simp add: l_set_tag_name_get_disconnected_nodes_def
      l_set_tag_name_get_disconnected_nodes_axioms_def)
  using set_tag_name_get_disconnected_nodes
  by fast


subsubsection ‹adopt\_node›

global_interpretation l_adopt_nodeCore_DOM_defs get_owner_document get_parent get_parent_locs
  remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs
  set_disconnected_nodes set_disconnected_nodes_locs
  defines adopt_node = a_adopt_node
    and adopt_node_locs = a_adopt_node_locs
  .
interpretation i_adopt_node?: l_adopt_nodeCore_DOM get_owner_document get_parent get_parent_locs
  remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs
  set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr type_wf
  get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs remove
  by(auto simp add: l_adopt_nodeCore_DOM_def l_adopt_nodeCore_DOM_axioms_def adopt_node_def
      adopt_node_locs_def instances)
declare l_adopt_nodeCore_DOM_axioms[instances]

lemma adopt_node_is_l_adopt_node [instances]: "l_adopt_node type_wf known_ptr known_ptrs get_parent
  adopt_node adopt_node_locs get_child_nodes get_owner_document"
  apply(auto simp add: l_adopt_node_def l_adopt_node_axioms_def instances)[1]
  using adopt_node_writes apply fast
  using adopt_node_pointers_preserved apply (fast, fast)
  using adopt_node_types_preserved apply (fast, fast)
  using adopt_node_child_in_heap apply fast
  using adopt_node_children_subset apply fast
  done



paragraph ‹get\_shadow\_root›

locale l_adopt_node_get_shadow_rootShadow_DOM =
  l_set_child_nodes_get_shadow_rootShadow_DOM +
  l_set_disconnected_nodes_get_shadow_rootShadow_DOM +
  l_adopt_nodeCore_DOM
begin
lemma adopt_node_get_shadow_root:
  "∀w ∈ adopt_node_locs parent owner_document document_ptr.
    (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: adopt_node_locs_def remove_child_locs_def all_args_def
      set_disconnected_nodes_get_shadow_root set_child_nodes_get_shadow_root)
end

locale l_adopt_node_get_shadow_root = l_adopt_node_defs + l_get_shadow_root_defs +
  assumes adopt_node_get_shadow_root:
    "∀w ∈ adopt_node_locs parent owner_document document_ptr.
    (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

interpretation i_adopt_node_get_shadow_root?: l_adopt_node_get_shadow_rootShadow_DOM type_wf known_ptr
  DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
  Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_shadow_root
  get_shadow_root_locs set_disconnected_nodes set_disconnected_nodes_locs get_owner_document
  get_parent get_parent_locs remove_child remove_child_locs get_disconnected_nodes
  get_disconnected_nodes_locs adopt_node adopt_node_locs get_child_nodes get_child_nodes_locs
  known_ptrs remove
  by(auto simp add: l_adopt_node_get_shadow_rootShadow_DOM_def instances)
declare l_adopt_node_get_shadow_rootShadow_DOM_axioms[instances]

lemma adopt_node_get_shadow_root_is_l_adopt_node_get_shadow_root [instances]:
  "l_adopt_node_get_shadow_root adopt_node_locs get_shadow_root_locs"
  apply(auto simp add: l_adopt_node_get_shadow_root_def)[1]
  using adopt_node_get_shadow_root apply fast
  done



subsubsection ‹insert\_before›

global_interpretation l_insert_beforeCore_DOM_defs get_parent get_parent_locs get_child_nodes
  get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si get_ancestors_si_locs
  adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_owner_document
  defines
    next_sibling = a_next_sibling and
    insert_node = a_insert_node and
    ensure_pre_insertion_validity = a_ensure_pre_insertion_validity and
    insert_before = a_insert_before and
    insert_before_locs = a_insert_before_locs
  .
global_interpretation l_append_childCore_DOM_defs insert_before
  defines append_child = "l_append_childCore_DOM_defs.a_append_child insert_before"
  .

interpretation i_insert_before?: l_insert_beforeCore_DOM get_parent get_parent_locs get_child_nodes
  get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si get_ancestors_si_locs
  adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_owner_document insert_before insert_before_locs append_child type_wf
  known_ptr known_ptrs
  by(auto simp add: l_insert_beforeCore_DOM_def l_insert_beforeCore_DOM_axioms_def insert_before_def
      insert_before_locs_def instances)
declare l_insert_beforeCore_DOM_axioms [instances]

interpretation i_append_child?: l_append_childCore_DOM append_child insert_before insert_before_locs
  by(simp add: l_append_childCore_DOM_def instances append_child_def)
declare l_append_childCore_DOM_axioms[instances]


subsubsection ‹get\_assigned\_nodes›

fun map_filter_M2 :: "('x ⇒ ('heap, 'e, 'y option) prog) ⇒ 'x list
  ⇒ ('heap, 'e, 'y list) prog"
  where
    "map_filter_M2 f [] = return []" |
    "map_filter_M2 f (x # xs) = do {
      res ← f x;
      remainder ← map_filter_M2 f xs;
      return ((case res of  Some r ⇒ [r] | None ⇒ []) @ remainder)
    }"
lemma map_filter_M2_pure [simp]:
  assumes "⋀x. x ∈ set xs ⟹ pure (f x) h"
  shows "pure (map_filter_M2 f xs) h"
  using assms
  apply(induct xs arbitrary: h)
  by(auto elim!: bind_returns_result_E2 intro!: bind_pure_I)

lemma map_filter_pure_no_monad:
  assumes "⋀x. x ∈ set xs ⟹ pure (f x) h"
  assumes "h ⊢ map_filter_M2 f xs →r ys"
  shows
    "ys = map the (filter (λx. x ≠ None) (map (λx. |h ⊢ f x|r) xs))" and
    "⋀x. x ∈ set xs ⟹ h ⊢ ok (f x)"
  using assms
   apply(induct xs arbitrary: h ys)
  by(auto elim!: bind_returns_result_E2)

lemma map_filter_pure_foo:
  assumes "⋀x. x ∈ set xs ⟹ pure (f x) h"
  assumes "h ⊢ map_filter_M2 f xs →r ys"
  assumes "y ∈ set ys"
  obtains x where "h ⊢ f x →r Some y" and "x ∈ set xs"
  using assms
  apply(induct xs arbitrary: ys)
  by(auto elim!: bind_returns_result_E2)


lemma map_filter_M2_in_result:
  assumes "h ⊢ map_filter_M2 P xs →r ys"
  assumes "a ∈ set xs"
  assumes "⋀x. x ∈ set xs ⟹ pure (P x) h"
  assumes "h ⊢ P a →r Some b"
  shows "b ∈ set ys"
  using assms
  apply(induct xs arbitrary: h ys)
  by(auto elim!: bind_returns_result_E2 )


locale l_assigned_nodesShadow_DOM_defs =
  l_get_tag_name_defs get_tag_name get_tag_name_locs +
  l_get_root_node_defs get_root_node get_root_node_locs +
  l_get_host_defs get_host get_host_locs +
  l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
  l_find_slot_defs find_slot assigned_slot +
  l_remove_defs remove +
  l_insert_before_defs insert_before insert_before_locs +
  l_append_child_defs append_child +
  l_remove_shadow_root_defs remove_shadow_root remove_shadow_root_locs
  for get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_root_node :: "(_) object_ptr ⇒ ((_) heap, exception, (_) object_ptr) prog"
    and get_root_node_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and find_slot :: "bool ⇒ (_) node_ptr ⇒ ((_) heap, exception, (_) element_ptr option) prog"
    and assigned_slot :: "(_) node_ptr ⇒ ((_) heap, exception, (_) element_ptr option) prog"
    and remove :: "(_) node_ptr ⇒ ((_) heap, exception, unit) prog"
    and insert_before ::
    "(_) object_ptr ⇒ (_) node_ptr ⇒ (_) node_ptr option ⇒ ((_) heap, exception, unit) prog"
    and insert_before_locs ::  "(_) object_ptr ⇒ (_) object_ptr option ⇒ (_) document_ptr ⇒
    (_) document_ptr ⇒ (_, unit) dom_prog set"
    and append_child :: "(_) object_ptr ⇒ (_) node_ptr ⇒ ((_) heap, exception, unit) prog"
    and remove_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog"
    and remove_shadow_root_locs :: "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒
    ((_) heap, exception, unit) prog set"
begin
definition a_assigned_nodes :: "(_) element_ptr ⇒ (_, (_) node_ptr list) dom_prog"
  where
    "a_assigned_nodes slot = do {
      tag ← get_tag_name slot;
      (if tag ≠ ''slot''
      then error HierarchyRequestError
      else return ());
      root ← get_root_node (cast slot);
      if is_shadow_root_ptr_kind root
      then do {
        host ← get_host (the (cast root));
        children ← get_child_nodes (cast host);
        filter_M (λslotable. do {
          found_slot ← find_slot False slotable;
          return (found_slot = Some slot)}) children}
      else return []}"

partial_function (dom_prog) a_assigned_nodes_flatten ::
  "(_) element_ptr ⇒ (_, (_) node_ptr list) dom_prog"
  where
    "a_assigned_nodes_flatten slot = do {
      tag ← get_tag_name slot;
      (if tag ≠ ''slot''
      then error HierarchyRequestError
      else return ());
      root ← get_root_node (cast slot);
      (if is_shadow_root_ptr_kind root
      then do {
        slotables ← a_assigned_nodes slot;
        slotables_or_child_nodes ← (if slotables = []
        then do {
          get_child_nodes (cast slot)
        } else do {
          return slotables
        });
        list_of_lists ← map_M (λnode_ptr. do {
          (case cast node_ptr of
            Some element_ptr ⇒ do {
              tag ← get_tag_name element_ptr;
              (if tag = ''slot''
              then do {
                root ← get_root_node (cast element_ptr);
                (if is_shadow_root_ptr_kind root
                then do {
                  a_assigned_nodes_flatten element_ptr
                } else do {
                  return [node_ptr]
                })
              } else do {
                return [node_ptr]
              })
            }
            | None ⇒ return [node_ptr])
        }) slotables_or_child_nodes;
        return (concat list_of_lists)
      } else return [])
    }"

definition a_flatten_dom :: "(_, unit) dom_prog" where
  "a_flatten_dom = do {
    tups ← element_ptr_kinds_M ⤜ map_filter_M2 (λelement_ptr. do {
      tag ← get_tag_name element_ptr;
      assigned_nodes ← a_assigned_nodes element_ptr;
      (if tag = ''slot'' ∧ assigned_nodes ≠ []
       then return (Some (element_ptr, assigned_nodes))
       else return None)});
    forall_M (λ(slot, assigned_nodes). do {
      get_child_nodes (cast slot) ⤜ forall_M remove;
      forall_M (append_child (cast slot)) assigned_nodes
    }) tups;
    shadow_root_ptr_kinds_M ⤜ forall_M (λshadow_root_ptr. do {
      host ← get_host shadow_root_ptr;
      get_child_nodes (cast host) ⤜ forall_M remove;
      get_child_nodes (cast shadow_root_ptr) ⤜ forall_M (append_child (cast host));
      remove_shadow_root host
    });
    return ()
  }"
end

global_interpretation l_assigned_nodesShadow_DOM_defs get_child_nodes get_child_nodes_locs
  get_tag_name get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
  assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
  remove_shadow_root_locs
  defines assigned_nodes = a_assigned_nodes
    and assigned_nodes_flatten = a_assigned_nodes_flatten
    and flatten_dom = a_flatten_dom
  .

declare a_assigned_nodes_flatten.simps [code]

locale l_assigned_nodes_defs =
  fixes assigned_nodes :: "(_) element_ptr ⇒ (_, (_) node_ptr list) dom_prog"
  fixes assigned_nodes_flatten :: "(_) element_ptr ⇒ (_, (_) node_ptr list) dom_prog"
  fixes flatten_dom :: "(_, unit) dom_prog"

locale l_assigned_nodesShadow_DOM =
  l_assigned_nodes_defs
  assigned_nodes assigned_nodes_flatten flatten_dom
  + l_assigned_nodesShadow_DOM_defs
  get_child_nodes get_child_nodes_locs get_tag_name get_tag_name_locs get_root_node
  get_root_node_locs get_host get_host_locs find_slot assigned_slot remove insert_before
  insert_before_locs append_child remove_shadow_root remove_shadow_root_locs
  + l_get_shadow_root
  type_wf get_shadow_root get_shadow_root_locs
  + l_set_shadow_root
  type_wf set_shadow_root set_shadow_root_locs
  + l_remove
  + l_insert_before
  insert_before insert_before_locs
  + l_find_slot
  find_slot assigned_slot
  + l_get_tag_name
  type_wf get_tag_name get_tag_name_locs
  + l_get_root_node
  get_root_node get_root_node_locs get_parent get_parent_locs
  + l_get_host
  get_host get_host_locs
  + l_get_child_nodes
  type_wf known_ptr get_child_nodes get_child_nodes_locs
  + l_to_tree_order
  to_tree_order
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and assigned_nodes :: "(_) element_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and assigned_nodes_flatten :: "(_) element_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and flatten_dom :: "((_) heap, exception, unit) prog"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_root_node :: "(_) object_ptr ⇒ ((_) heap, exception, (_) object_ptr) prog"
    and get_root_node_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and find_slot :: "bool ⇒ (_) node_ptr ⇒ ((_) heap, exception, (_) element_ptr option) prog"
    and assigned_slot :: "(_) node_ptr ⇒ ((_) heap, exception, (_) element_ptr option) prog"
    and remove :: "(_) node_ptr ⇒ ((_) heap, exception, unit) prog"
    and insert_before ::
    "(_) object_ptr ⇒ (_) node_ptr ⇒ (_) node_ptr option ⇒ ((_) heap, exception, unit) prog"
    and insert_before_locs ::  "(_) object_ptr ⇒ (_) object_ptr option ⇒ (_) document_ptr ⇒
    (_) document_ptr ⇒ (_, unit) dom_prog set"
    and append_child :: "(_) object_ptr ⇒ (_) node_ptr ⇒ ((_) heap, exception, unit) prog"
    and remove_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog"
    and remove_shadow_root_locs :: "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒
    ((_) heap, exception, unit) prog set"
    and type_wf :: "(_) heap ⇒ bool"
    and get_shadow_root ::
    "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and set_shadow_root ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ ((_) heap, exception, unit) prog"
    and set_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and get_parent :: "(_) node_ptr ⇒ ((_) heap, exception, (_) object_ptr option) prog"
    and get_parent_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and to_tree_order :: "(_) object_ptr ⇒ ((_) heap, exception, (_) object_ptr list) prog" +
  assumes assigned_nodes_impl: "assigned_nodes = a_assigned_nodes"
  assumes flatten_dom_impl: "flatten_dom = a_flatten_dom"
begin
lemmas assigned_nodes_def = assigned_nodes_impl[unfolded a_assigned_nodes_def]
lemmas flatten_dom_def = flatten_dom_impl[unfolded a_flatten_dom_def, folded assigned_nodes_impl]

lemma assigned_nodes_pure [simp]: "pure (assigned_nodes slot) h"
  by(auto simp add: assigned_nodes_def intro!: bind_pure_I filter_M_pure_I)

lemma assigned_nodes_ptr_in_heap:
  assumes "h ⊢ ok (assigned_nodes slot)"
  shows "slot |∈| element_ptr_kinds h"
  using assms
  apply(auto simp add: assigned_nodes_def)[1]
  by (meson bind_is_OK_E is_OK_returns_result_I local.get_tag_name_ptr_in_heap)

lemma assigned_nodes_slot_is_slot:
  assumes "h ⊢ ok (assigned_nodes slot)"
  shows "h ⊢ get_tag_name slot →r ''slot''"
  using assms
  by(auto simp add: assigned_nodes_def elim!: bind_is_OK_E split: if_splits)

lemma assigned_nodes_different_ptr:
  assumes "h ⊢ assigned_nodes slot →r nodes"
  assumes "h ⊢ assigned_nodes slot' →r nodes'"
  assumes "slot ≠ slot'"
  shows "set nodes ∩ set nodes' = {}"
proof (rule ccontr)
  assume "set nodes ∩ set nodes' ≠ {} "
  then obtain common_ptr where "common_ptr ∈ set nodes" and "common_ptr ∈ set nodes'"
    by auto

  have "h ⊢ find_slot False common_ptr →r Some slot"
    using ‹common_ptr ∈ set nodes›
    using assms(1)
    by(auto simp add: assigned_nodes_def
        elim!: bind_returns_result_E2
        split: if_splits
        dest!: filter_M_holds_for_result[where x=common_ptr]
        intro!: bind_pure_I)
  moreover
  have "h ⊢ find_slot False common_ptr →r Some slot'"
    using ‹common_ptr ∈ set nodes'›
    using assms(2)
    by(auto simp add: assigned_nodes_def
        elim!: bind_returns_result_E2
        split: if_splits
        dest!: filter_M_holds_for_result[where x=common_ptr]
        intro!: bind_pure_I)
  ultimately
  show False
    using assms(3)
    by (meson option.inject returns_result_eq)
qed
end

interpretation i_assigned_nodes?: l_assigned_nodesShadow_DOM known_ptr assigned_nodes
  assigned_nodes_flatten flatten_dom get_child_nodes get_child_nodes_locs get_tag_name
  get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
  assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
  remove_shadow_root_locs type_wf get_shadow_root get_shadow_root_locs set_shadow_root
  set_shadow_root_locs get_parent get_parent_locs to_tree_order
  by(auto simp add: instances l_assigned_nodesShadow_DOM_def l_assigned_nodesShadow_DOM_axioms_def
      assigned_nodes_def flatten_dom_def)
declare l_assigned_nodesShadow_DOM_axioms [instances]

locale l_assigned_nodes = l_assigned_nodes_defs +
  assumes assigned_nodes_pure [simp]: "pure (assigned_nodes slot) h"
  assumes assigned_nodes_ptr_in_heap:
    "h ⊢ ok (assigned_nodes slot) ⟹ slot |∈| element_ptr_kinds h"
  assumes assigned_nodes_slot_is_slot:
    "h ⊢ ok (assigned_nodes slot) ⟹ h ⊢ get_tag_name slot →r ''slot''"
  assumes assigned_nodes_different_ptr:
    "h ⊢ assigned_nodes slot →r nodes ⟹ h ⊢ assigned_nodes slot' →r nodes' ⟹
  slot ≠ slot' ⟹ set nodes ∩ set nodes' = {}"

lemma assigned_nodes_is_l_assigned_nodes [instances]: "l_assigned_nodes assigned_nodes"
  apply(auto simp add: l_assigned_nodes_def)[1]
  using assigned_nodes_ptr_in_heap apply fast
  using assigned_nodes_slot_is_slot apply fast
  using assigned_nodes_different_ptr apply fast
  done

subsubsection ‹set\_val›

locale l_set_valShadow_DOM =
  CD: l_set_valCore_DOM type_wfCore_DOM set_val set_val_locs +
  l_type_wf type_wf
  for type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and set_val :: "(_) character_data_ptr ⇒ char list ⇒ (_, unit) dom_prog"
    and set_val_locs :: "(_) character_data_ptr ⇒ (_, unit) dom_prog set"  +
  assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
begin

lemma set_val_ok:
  "type_wf h ⟹ character_data_ptr |∈| character_data_ptr_kinds h ⟹
  h ⊢ ok (set_val character_data_ptr tag)"
  using CD.set_val_ok CD.type_wf_impl ShadowRootClass.type_wfDocument local.type_wf_impl by blast

lemma set_val_writes:
  "writes (set_val_locs character_data_ptr) (set_val character_data_ptr tag) h h'"
  using CD.set_val_writes .

lemma set_val_pointers_preserved:
  assumes "w ∈ set_val_locs character_data_ptr"
  assumes "h ⊢ w →h h'"
  shows "object_ptr_kinds h = object_ptr_kinds h'"
  using assms CD.set_val_pointers_preserved by simp

lemma set_val_typess_preserved:
  assumes "w ∈ set_val_locs character_data_ptr"
  assumes "h ⊢ w →h h'"
  shows "type_wf h = type_wf h'"
  apply(unfold type_wf_impl)
  using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
  by(auto simp add: all_args_def CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
      split: if_splits)
end

interpretation
  i_set_val?: l_set_valShadow_DOM type_wf DocumentClass.type_wf set_val set_val_locs
  apply(unfold_locales)
  by (auto simp add: set_val_def set_val_locs_def)
declare l_set_valShadow_DOM_axioms[instances]

lemma set_val_is_l_set_val [instances]: "l_set_val type_wf set_val set_val_locs"
  apply(simp add: l_set_val_def)
  using set_val_ok set_val_writes set_val_pointers_preserved set_val_typess_preserved
  by blast

paragraph ‹get\_shadow\_root›

locale l_set_val_get_shadow_rootShadow_DOM =
  l_set_valShadow_DOM +
  l_get_shadow_rootShadow_DOM
begin
lemma set_val_get_shadow_root:
  "∀w ∈ set_val_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"
  by(auto simp add: CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
      get_shadow_root_locs_def all_args_def)
end

locale l_set_val_get_shadow_root = l_set_val + l_get_shadow_root +
  assumes set_val_get_shadow_root:
    "∀w ∈ set_val_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_shadow_root_locs ptr'. r h h'))"

interpretation
  i_set_val_get_shadow_root?: l_set_val_get_shadow_rootShadow_DOM type_wf DocumentClass.type_wf
  set_val set_val_locs
  get_shadow_root get_shadow_root_locs
  apply(auto simp add: l_set_val_get_shadow_rootShadow_DOM_def  instances)[1]
  using l_set_valShadow_DOM_axioms
  by unfold_locales
declare l_set_val_get_shadow_rootShadow_DOM_axioms[instances]

lemma set_val_get_shadow_root_is_l_set_val_get_shadow_root [instances]:
  "l_set_val_get_shadow_root type_wf set_val set_val_locs get_shadow_root
                                  get_shadow_root_locs"
  using set_val_is_l_set_val get_shadow_root_is_l_get_shadow_root
  apply(simp add: l_set_val_get_shadow_root_def l_set_val_get_shadow_root_axioms_def)
  using set_val_get_shadow_root
  by fast

paragraph ‹get\_tag\_type›

locale l_set_val_get_tag_nameShadow_DOM =
  l_set_valShadow_DOM +
  l_get_tag_nameShadow_DOM
begin
lemma set_val_get_tag_name:
  "∀w ∈ set_val_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"
  by(auto simp add: CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
      CD.get_tag_name_locs_impl[unfolded CD.a_get_tag_name_locs_def]
      all_args_def)
end

locale l_set_val_get_tag_name = l_set_val + l_get_tag_name +
  assumes set_val_get_tag_name:
    "∀w ∈ set_val_locs ptr. (h ⊢ w →h h' ⟶ (∀r ∈ get_tag_name_locs ptr'. r h h'))"

interpretation
  i_set_val_get_tag_name?: l_set_val_get_tag_nameShadow_DOM type_wf DocumentClass.type_wf set_val
  set_val_locs get_tag_name get_tag_name_locs
  by unfold_locales
declare l_set_val_get_tag_nameShadow_DOM_axioms[instances]

lemma set_val_get_tag_name_is_l_set_val_get_tag_name [instances]:
  "l_set_val_get_tag_name type_wf set_val set_val_locs get_tag_name get_tag_name_locs"
  using set_val_is_l_set_val get_tag_name_is_l_get_tag_name
  apply(simp add: l_set_val_get_tag_name_def l_set_val_get_tag_name_axioms_def)
  using set_val_get_tag_name
  by fast

subsubsection ‹create\_character\_data›


locale l_create_character_dataShadow_DOM =
  CD: l_create_character_dataCore_DOM _ _ _ _ _ _ type_wfCore_DOM _ known_ptrCore_DOM +
  l_known_ptr known_ptr
  for known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool" +
  assumes known_ptr_impl: "known_ptr = a_known_ptr"
begin

lemma create_character_data_document_in_heap:
  assumes "h ⊢ ok (create_character_data document_ptr text)"
  shows "document_ptr |∈| document_ptr_kinds h"
  using assms CD.create_character_data_document_in_heap by simp

lemma create_character_data_known_ptr:
  assumes "h ⊢ create_character_data document_ptr text →r new_character_data_ptr"
  shows "known_ptr (cast new_character_data_ptr)"
  using assms CD.create_character_data_known_ptr
  by(simp add: known_ptr_impl CD.known_ptr_impl ShadowRootClass.a_known_ptr_def)
end

locale l_create_character_data = l_create_character_data_defs

interpretation i_create_character_data?: l_create_character_dataShadow_DOM get_disconnected_nodes
  get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs
  create_character_data known_ptr DocumentClass.type_wf DocumentClass.known_ptr
  by(auto simp add: l_create_character_dataShadow_DOM_def l_create_character_dataShadow_DOM_axioms_def
      instances)
declare l_create_character_dataCore_DOM_axioms [instances]

subsubsection ‹create\_element›

locale l_create_elementShadow_DOM =
  CD: l_create_elementCore_DOM get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
  set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wfCore_DOM create_element
  known_ptrCore_DOM +
  l_known_ptr known_ptr
  for get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and set_disconnected_nodes ::
    "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_tag_name :: "(_) element_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
    and set_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and type_wf :: "(_) heap ⇒ bool"
    and create_element ::
    "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and known_ptrCore_DOM :: "(_) object_ptr ⇒ bool" +
  assumes known_ptr_impl: "known_ptr = a_known_ptr"
begin
lemmas create_element_def = CD.create_element_def

lemma create_element_document_in_heap:
  assumes "h ⊢ ok (create_element document_ptr tag)"
  shows "document_ptr |∈| document_ptr_kinds h"
  using CD.create_element_document_in_heap assms .

lemma create_element_known_ptr:
  assumes "h ⊢ create_element document_ptr tag →r new_element_ptr"
  shows "known_ptr (cast new_element_ptr)"
proof -
  have "is_element_ptr new_element_ptr"
    using assms
    apply(auto simp add: create_element_def elim!: bind_returns_result_E)[1]
    using new_element_is_element_ptr
    by blast
  then show ?thesis
    by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
        CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs)
qed
end

interpretation i_create_element?: l_create_elementShadow_DOM get_disconnected_nodes
  get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_name
  set_tag_name_locs type_wf create_element known_ptr DocumentClass.type_wf DocumentClass.known_ptr
  by(auto simp add: l_create_elementShadow_DOM_def l_create_elementShadow_DOM_axioms_def instances)
declare l_create_elementShadow_DOM_axioms[instances]



subsection ‹A wellformed heap (Core DOM)›

subsubsection ‹wellformed\_heap›


locale l_heap_is_wellformedShadow_DOM_defs =
  CD: l_heap_is_wellformedCore_DOM_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs +
  l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
  l_get_tag_name_defs get_tag_name get_tag_name_locs
  for get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin
definition a_host_shadow_root_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
  where
    "a_host_shadow_root_rel h = (λ(x, y). (cast x, cast y)) ` {(host, shadow_root).
      host |∈| element_ptr_kinds h ∧ |h ⊢ get_shadow_root host|r = Some shadow_root}"

lemma a_host_shadow_root_rel_code [code]: "a_host_shadow_root_rel h = set (concat (map
  (λhost. (case |h ⊢ get_shadow_root host|r of
    Some shadow_root ⇒ [(cast host, cast shadow_root)] |
    None ⇒ []))
  (sorted_list_of_fset (element_ptr_kinds h)))
)"
  by(auto simp add: a_host_shadow_root_rel_def)

definition a_all_ptrs_in_heap :: "(_) heap ⇒ bool" where
  "a_all_ptrs_in_heap h = ((∀host shadow_root_ptr.
    (h ⊢ get_shadow_root host →r Some shadow_root_ptr) ⟶
      shadow_root_ptr |∈| shadow_root_ptr_kinds h))"

definition a_distinct_lists :: "(_) heap ⇒ bool"
  where
    "a_distinct_lists h = distinct (concat (
      map (λelement_ptr. (case |h ⊢ get_shadow_root element_ptr|r of
        Some shadow_root_ptr ⇒ [shadow_root_ptr] | None ⇒ []))
        |h ⊢ element_ptr_kinds_M|r
    ))"


definition a_shadow_root_valid :: "(_) heap ⇒ bool" where
  "a_shadow_root_valid h = (∀shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h).
     (∃host ∈ fset(element_ptr_kinds h).
       |h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
       |h ⊢ get_shadow_root host|r = Some shadow_root_ptr))"

definition a_heap_is_wellformed :: "(_) heap ⇒ bool"
  where
    "a_heap_is_wellformed h ⟷ CD.a_heap_is_wellformed h ∧
      acyclic (CD.a_parent_child_rel h ∪ a_host_shadow_root_rel h) ∧
      a_all_ptrs_in_heap h ∧
      a_distinct_lists h ∧
      a_shadow_root_valid h"
end

global_interpretation l_heap_is_wellformedShadow_DOM_defs get_child_nodes get_child_nodes_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
  get_tag_name get_tag_name_locs
  defines heap_is_wellformed = a_heap_is_wellformed
    and parent_child_rel = CD.a_parent_child_rel
    and host_shadow_root_rel = a_host_shadow_root_rel
    and all_ptrs_in_heap = a_all_ptrs_in_heap
    and distinct_lists = a_distinct_lists
    and shadow_root_valid = a_shadow_root_valid
    and heap_is_wellformedCore_DOM = CD.a_heap_is_wellformed
    and parent_child_relCore_DOM = CD.a_parent_child_rel
    and acyclic_heapCore_DOM = CD.a_acyclic_heap
    and all_ptrs_in_heapCore_DOM = CD.a_all_ptrs_in_heap
    and distinct_listsCore_DOM = CD.a_distinct_lists
    and owner_document_validCore_DOM = CD.a_owner_document_valid
  .

interpretation i_heap_is_wellformedCore_DOM: l_heap_is_wellformedCore_DOM known_ptr type_wf
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  heap_is_wellformedCore_DOM parent_child_rel
  by (auto simp add: l_heap_is_wellformedCore_DOM_def l_heap_is_wellformedCore_DOM_axioms_def
      heap_is_wellformedCore_DOM_def parent_child_rel_def instances)
declare i_heap_is_wellformedCore_DOM.l_heap_is_wellformedCore_DOM_axioms[instances]

lemma heap_is_wellformedCore_DOM_is_l_heap_is_wellformed [instances]:
  "l_heap_is_wellformed type_wf known_ptr heap_is_wellformedCore_DOM parent_child_rel get_child_nodes
  get_disconnected_nodes"
  apply(auto simp add: l_heap_is_wellformed_def)[1]
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_children_in_heap apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_disc_nodes_in_heap apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_one_parent apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_one_disc_parent apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_children_disc_nodes_different apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_disconnected_nodes_distinct apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_children_distinct apply blast
  using i_heap_is_wellformedCore_DOM.heap_is_wellformed_children_disc_nodes apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_child apply (blast, blast)
  using i_heap_is_wellformedCore_DOM.parent_child_rel_finite apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_acyclic apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_node_ptr apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_parent_in_heap apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_child_in_heap apply blast
  done


locale l_heap_is_wellformedShadow_DOM =
  l_heap_is_wellformedShadow_DOM_defs
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
  + CD: l_heap_is_wellformedCore_DOM
  known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs heap_is_wellformedCore_DOM parent_child_rel
  + l_heap_is_wellformed_defs
  heap_is_wellformed parent_child_rel
  + l_get_hostShadow_DOM
  get_shadow_root get_shadow_root_locs get_host get_host_locs type_wf
  + l_get_disconnected_documentCore_DOM get_disconnected_nodes get_disconnected_nodes_locs
  get_disconnected_document get_disconnected_document_locs type_wf
  + l_get_shadow_rootShadow_DOM type_wf get_shadow_root get_shadow_root_locs
  for get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and known_ptr :: "(_) object_ptr ⇒ bool"
    and type_wf :: "(_) heap ⇒ bool"
    and heap_is_wellformed :: "(_) heap ⇒ bool"
    and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
    and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_document :: "(_) node_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
    and get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set" +
  assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed"
begin
lemmas heap_is_wellformed_def =
  heap_is_wellformed_impl[unfolded a_heap_is_wellformed_def,
    folded CD.heap_is_wellformed_impl CD.parent_child_rel_impl]

lemma a_distinct_lists_code [code]:
  "a_all_ptrs_in_heap h = ((∀host ∈ fset (element_ptr_kinds h).
    h ⊢ ok (get_shadow_root host) ⟶ (case |h ⊢ get_shadow_root host|r of
    Some shadow_root_ptr ⇒ shadow_root_ptr |∈| shadow_root_ptr_kinds h |
    None ⇒ True)))"
  apply(auto simp add: a_all_ptrs_in_heap_def split: option.splits)[1]
  by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap select_result_I2)

lemma get_shadow_root_shadow_root_ptr_in_heap:
  assumes "heap_is_wellformed h"
  assumes "h ⊢ get_shadow_root host →r Some shadow_root_ptr"
  shows "shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  using assms
  by(auto simp add: heap_is_wellformed_def a_all_ptrs_in_heap_def)

lemma get_host_ptr_in_heap:
  assumes "heap_is_wellformed h"
  assumes "h ⊢ get_host shadow_root_ptr →r host"
  shows "shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  using assms get_shadow_root_shadow_root_ptr_in_heap
  by(auto simp add: get_host_def
      elim!: bind_returns_result_E2
      dest!: filter_M_holds_for_result
      intro!: bind_pure_I
      split: list.splits)

lemma shadow_root_same_host:
  assumes "heap_is_wellformed h" and "type_wf h"
  assumes "h ⊢ get_shadow_root host →r Some shadow_root_ptr"
  assumes "h ⊢ get_shadow_root host' →r Some shadow_root_ptr"
  shows "host = host'"
proof (rule ccontr)
  assume " host ≠ host'"
  have "host |∈| element_ptr_kinds h"
    using assms(3)
    by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap)
  moreover
  have "host' |∈| element_ptr_kinds h"
    using assms(4)
    by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap)
  ultimately show False
    using assms
    apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1]
    apply(drule distinct_concat_map_E(1)[where x=host and y=host'])
       apply(simp)
      apply(simp)
    using ‹host ≠ host'› apply(simp)
    apply(auto)[1]
    done
qed

lemma shadow_root_host_dual:
  assumes "h ⊢ get_host shadow_root_ptr →r host"
  shows "h ⊢ get_shadow_root host →r Some shadow_root_ptr"
  using assms
  by(auto simp add: get_host_def
      dest: filter_M_holds_for_result
      elim!: bind_returns_result_E2
      intro!: bind_pure_I split: list.splits)

lemma disc_doc_disc_node_dual:
  assumes "h ⊢ get_disconnected_document disc_node →r disc_doc"
  obtains disc_nodes where
    "h ⊢ get_disconnected_nodes disc_doc →r disc_nodes" and
    "disc_node ∈ set disc_nodes"
  using assms get_disconnected_nodes_pure
  by(auto simp add: get_disconnected_document_def bind_pure_I
      dest!: filter_M_holds_for_result
      elim!: bind_returns_result_E2
      intro!: filter_M_pure_I
      split: if_splits list.splits)

lemma get_host_valid_tag_name:
  assumes "heap_is_wellformed h" and "type_wf h"
  assumes "h ⊢ get_host shadow_root_ptr →r host"
  assumes "h ⊢ get_tag_name host →r tag"
  shows "tag ∈ safe_shadow_root_element_types"
proof -
  obtain host' where
    "host' |∈| element_ptr_kinds h" and
    "|h ⊢ get_tag_name host'|r ∈ safe_shadow_root_element_types"
    and "h ⊢ get_shadow_root host' →r Some shadow_root_ptr"
    using assms
    by (metis get_host_ptr_in_heap local.a_shadow_root_valid_def
        local.get_shadow_root_ok local.heap_is_wellformed_def returns_result_select_result)
  then have "host = host'"
    by (meson assms(1) assms(2) assms(3) shadow_root_host_dual shadow_root_same_host)
  then show ?thesis
    using ‹|h ⊢ get_tag_name host'|r ∈ safe_shadow_root_element_types› assms(4) by auto
qed


lemma a_host_shadow_root_rel_finite: "finite (a_host_shadow_root_rel h)"
proof -
  have "a_host_shadow_root_rel h = (⋃host ∈ fset (element_ptr_kinds h).
    (case |h ⊢ get_shadow_root host|r of
      Some shadow_root ⇒ {(cast host, cast shadow_root)} | None ⇒ {}))"
    by(auto simp add: a_host_shadow_root_rel_def split: option.splits)
  moreover have "finite (⋃host ∈ fset (element_ptr_kinds h).
    (case |h ⊢ get_shadow_root host|r of
      Some shadow_root ⇒ {(castelement_ptr2object_ptr host, castshadow_root_ptr2object_ptr shadow_root)} |
      None ⇒ {}))"
    by(auto split: option.splits)
  ultimately show ?thesis
    by auto
qed

lemma heap_is_wellformed_children_in_heap:
  "heap_is_wellformed h ⟹ h ⊢ get_child_nodes ptr →r children ⟹ child ∈ set children ⟹
  child |∈| node_ptr_kinds h"
  using CD.heap_is_wellformed_children_in_heap local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_disc_nodes_in_heap:
  "heap_is_wellformed h ⟹ h ⊢ get_disconnected_nodes document_ptr →r disc_nodes ⟹
  node ∈ set disc_nodes ⟹ node |∈| node_ptr_kinds h"
  using CD.heap_is_wellformed_disc_nodes_in_heap local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_one_parent:
  "heap_is_wellformed h ⟹ h ⊢ get_child_nodes ptr →r children ⟹
  h ⊢ get_child_nodes ptr' →r children' ⟹ set children ∩ set children' ≠ {} ⟹ ptr = ptr'"
  using CD.heap_is_wellformed_one_parent local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_one_disc_parent:
  "heap_is_wellformed h ⟹ h ⊢ get_disconnected_nodes document_ptr →r disc_nodes ⟹
  h ⊢ get_disconnected_nodes document_ptr' →r disc_nodes' ⟹ set disc_nodes ∩ set disc_nodes' ≠ {}
  ⟹ document_ptr = document_ptr'"
  using CD.heap_is_wellformed_one_disc_parent local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_children_disc_nodes_different:
  "heap_is_wellformed h ⟹ h ⊢ get_child_nodes ptr →r children ⟹
  h ⊢ get_disconnected_nodes document_ptr →r disc_nodes ⟹ set children ∩ set disc_nodes = {}"
  using CD.heap_is_wellformed_children_disc_nodes_different local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_disconnected_nodes_distinct:
  "heap_is_wellformed h ⟹ h ⊢ get_disconnected_nodes document_ptr →r disc_nodes ⟹
  distinct disc_nodes"
  using CD.heap_is_wellformed_disconnected_nodes_distinct local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_children_distinct:
  "heap_is_wellformed h ⟹ h ⊢ get_child_nodes ptr →r children ⟹ distinct children"
  using CD.heap_is_wellformed_children_distinct local.heap_is_wellformed_def by blast
lemma heap_is_wellformed_children_disc_nodes:
  "heap_is_wellformed h ⟹ node_ptr |∈| node_ptr_kinds h ⟹
  ¬(∃parent ∈ fset (object_ptr_kinds h). node_ptr ∈ set |h ⊢ get_child_nodes parent|r) ⟹
  (∃document_ptr ∈ fset (document_ptr_kinds h).
    node_ptr ∈ set |h ⊢ get_disconnected_nodes document_ptr|r)"
  using CD.heap_is_wellformed_children_disc_nodes local.heap_is_wellformed_def by blast
lemma parent_child_rel_finite: "heap_is_wellformed h ⟹ finite (parent_child_rel h)"
  using CD.parent_child_rel_finite by blast
lemma parent_child_rel_acyclic: "heap_is_wellformed h ⟹ acyclic (parent_child_rel h)"
  using CD.parent_child_rel_acyclic heap_is_wellformed_def by blast
lemma parent_child_rel_child_in_heap:
  "heap_is_wellformed h ⟹ type_wf h ⟹ known_ptr parent ⟹
  (parent, child_ptr) ∈ parent_child_rel h ⟹ child_ptr |∈| object_ptr_kinds h"
  using CD.parent_child_rel_child_in_heap local.heap_is_wellformed_def by blast
end

interpretation i_heap_is_wellformed?: l_heap_is_wellformedShadow_DOM get_child_nodes
  get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root
  get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf heap_is_wellformed
  parent_child_rel heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs
  by(auto simp add: l_heap_is_wellformedShadow_DOM_def l_heap_is_wellformedShadow_DOM_axioms_def
      l_heap_is_wellformedCore_DOM_def l_heap_is_wellformedCore_DOM_axioms_def
      heap_is_wellformedCore_DOM_def parent_child_rel_def heap_is_wellformed_def
      instances)
declare l_heap_is_wellformedShadow_DOM_axioms [instances]

lemma heap_is_wellformed_is_l_heap_is_wellformed [instances]:
  "l_heap_is_wellformed ShadowRootClass.type_wf ShadowRootClass.known_ptr
    Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel Shadow_DOM.get_child_nodes
    get_disconnected_nodes"
  apply(auto simp add: l_heap_is_wellformed_def instances)[1]
  using heap_is_wellformed_children_in_heap apply metis
  using heap_is_wellformed_disc_nodes_in_heap apply metis
  using heap_is_wellformed_one_parent apply blast
  using heap_is_wellformed_one_disc_parent apply blast
  using heap_is_wellformed_children_disc_nodes_different apply blast
  using heap_is_wellformed_disconnected_nodes_distinct apply metis
  using heap_is_wellformed_children_distinct apply metis
  using heap_is_wellformed_children_disc_nodes apply metis
  using i_heap_is_wellformedCore_DOM.parent_child_rel_child apply(blast, blast)
  using i_heap_is_wellformedCore_DOM.parent_child_rel_finite apply blast
  using parent_child_rel_acyclic apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_node_ptr apply blast
  using i_heap_is_wellformedCore_DOM.parent_child_rel_parent_in_heap apply blast
  using parent_child_rel_child_in_heap apply metis
  done


subsubsection ‹get\_parent›

interpretation i_get_parent_wfCore_DOM: l_get_parent_wfCore_DOM known_ptr type_wf get_child_nodes
  get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformedCore_DOM
  parent_child_rel get_disconnected_nodes
  by(simp add: l_get_parent_wfCore_DOM_def instances)
declare i_get_parent_wfCore_DOM.l_get_parent_wfCore_DOM_axioms[instances]

interpretation i_get_parent_wf2Core_DOM: l_get_parent_wf2Core_DOM known_ptr type_wf get_child_nodes
  get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformedCore_DOM
  parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
  by(auto simp add: l_get_parent_wf2Core_DOM_def instances)
declare i_get_parent_wf2Core_DOM.l_get_parent_wf2Core_DOM_axioms[instances]

lemma get_parent_wfCore_DOM_is_l_get_parent_wf [instances]: "l_get_parent_wf type_wf known_ptr
  known_ptrs heap_is_wellformedCore_DOM parent_child_rel get_child_nodes get_parent"
  apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def instances)[1]
  using i_get_parent_wf2Core_DOM.child_parent_dual apply fast
  using i_get_parent_wf2Core_DOM.heap_wellformed_induct apply metis
  using i_get_parent_wf2Core_DOM.heap_wellformed_induct_rev apply metis
  using i_get_parent_wf2Core_DOM.parent_child_rel_parent apply fast
  done


subsubsection ‹get\_disconnected\_nodes›


subsubsection ‹set\_disconnected\_nodes›


paragraph ‹get\_disconnected\_nodes›

interpretation i_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM:
  l_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM known_ptr type_wf
  get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
  set_disconnected_nodes_locs heap_is_wellformedCore_DOM parent_child_rel get_child_nodes
  by (simp add: l_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM_def instances)
declare i_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM.l_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM_axioms[instances]

lemma set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM_is_l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]:
  "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformedCore_DOM
    parent_child_rel get_child_nodes get_disconnected_nodes get_disconnected_nodes_locs
    set_disconnected_nodes set_disconnected_nodes_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def
      l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1]
  using i_set_disconnected_nodes_get_disconnected_nodes_wfCore_DOM.remove_from_disconnected_nodes_removes
  apply fast
  done


paragraph ‹get\_root\_node›

interpretation i_get_root_node_wfCore_DOM:l_get_root_node_wfCore_DOM known_ptr type_wf known_ptrs
  heap_is_wellformedCore_DOM parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs
  get_root_node get_root_node_locs
  by(simp add: l_get_root_node_wfCore_DOM_def instances)
declare i_get_root_node_wfCore_DOM.l_get_root_node_wfCore_DOM_axioms[instances]

lemma get_ancestors_wfCore_DOM_is_l_get_ancestors_wf [instances]:
  "l_get_ancestors_wf heap_is_wellformedCore_DOM parent_child_rel known_ptr known_ptrs type_wf
  get_ancestors get_ancestors_locs get_child_nodes get_parent"
  apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def instances)[1]
  using i_get_root_node_wfCore_DOM.get_ancestors_never_empty apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_ok apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_reads apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_ptrs_in_heap apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_remains_not_in_ancestors apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_also_parent apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_obtains_children apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_parent_child_rel apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_parent_child_rel apply blast
  done

lemma get_root_node_wfCore_DOM_is_l_get_root_node_wf [instances]:
  "l_get_root_node_wf heap_is_wellformedCore_DOM get_root_node type_wf known_ptr known_ptrs
    get_ancestors get_parent"
  apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def instances)[1]
  using i_get_root_node_wfCore_DOM.get_root_node_ok apply blast
  using i_get_root_node_wfCore_DOM.get_root_node_ptr_in_heap apply blast
  using i_get_root_node_wfCore_DOM.get_root_node_root_in_heap apply blast
  using i_get_root_node_wfCore_DOM.get_ancestors_same_root_node apply(blast, blast)
  using i_get_root_node_wfCore_DOM.get_root_node_same_no_parent apply blast
    (* using i_get_root_node_wfCore_DOM.get_root_node_not_node_same apply blast *)
  using i_get_root_node_wfCore_DOM.get_root_node_parent_same apply (blast, blast)
  done


subsubsection ‹to\_tree\_order›

interpretation i_to_tree_order_wfCore_DOM: l_to_tree_order_wfCore_DOM known_ptr type_wf get_child_nodes
  get_child_nodes_locs to_tree_order known_ptrs get_parent get_parent_locs heap_is_wellformedCore_DOM
  parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
  apply(simp add: l_to_tree_order_wfCore_DOM_def instances)
  done
declare i_to_tree_order_wfCore_DOM.l_to_tree_order_wfCore_DOM_axioms [instances]

lemma to_tree_order_wfCore_DOM_is_l_to_tree_order_wf [instances]:
  "l_to_tree_order_wf heap_is_wellformedCore_DOM parent_child_rel type_wf known_ptr known_ptrs
  to_tree_order get_parent get_child_nodes"
  apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def instances)[1]
  using i_to_tree_order_wfCore_DOM.to_tree_order_ok apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_ptrs_in_heap apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_parent_child_rel apply(blast, blast)
  using i_to_tree_order_wfCore_DOM.to_tree_order_child2 apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_node_ptrs apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_child apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_ptr_in_result apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_parent apply blast
  using i_to_tree_order_wfCore_DOM.to_tree_order_subset apply blast
  done

paragraph ‹get\_root\_node›

interpretation i_to_tree_order_wf_get_root_node_wfCore_DOM: l_to_tree_order_wf_get_root_node_wfCore_DOM
  known_ptr type_wf known_ptrs heap_is_wellformedCore_DOM parent_child_rel get_child_nodes
  get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs
  get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order
  by(auto simp add: l_to_tree_order_wf_get_root_node_wfCore_DOM_def instances)
declare i_to_tree_order_wf_get_root_node_wfCore_DOM.l_to_tree_order_wf_get_root_node_wfCore_DOM_axioms [instances]

lemma to_tree_order_wf_get_root_node_wfCore_DOM_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_wellformedCore_DOM"
  apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def
      l_to_tree_order_wf_get_root_node_wf_axioms_def instances)[1]
  using i_to_tree_order_wf_get_root_node_wfCore_DOM.to_tree_order_get_root_node apply blast
  using i_to_tree_order_wf_get_root_node_wfCore_DOM.to_tree_order_same_root apply blast
  done

subsubsection ‹remove\_child›

interpretation i_remove_child_wf2Core_DOM: l_remove_child_wf2Core_DOM 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_wellformedCore_DOM parent_child_rel
  by unfold_locales
declare i_remove_child_wf2Core_DOM.l_remove_child_wf2Core_DOM_axioms [instances]

lemma remove_child_wf2Core_DOM_is_l_remove_child_wf2 [instances]: "l_remove_child_wf2 type_wf known_ptr
  known_ptrs remove_child heap_is_wellformedCore_DOM get_child_nodes remove"
  apply(auto simp add: l_remove_child_wf2_def l_remove_child_wf2_axioms_def instances)[1]
  using i_remove_child_wf2Core_DOM.remove_child_heap_is_wellformed_preserved apply(fast, fast, fast)
  using i_remove_child_wf2Core_DOM.remove_heap_is_wellformed_preserved apply(fast, fast, fast)
  using i_remove_child_wf2Core_DOM.remove_child_removes_child apply fast
  using i_remove_child_wf2Core_DOM.remove_child_removes_first_child apply fast
  using i_remove_child_wf2Core_DOM.remove_removes_child apply fast
  using i_remove_child_wf2Core_DOM.remove_for_all_empty_children apply fast
  done


subsection ‹A wellformed heap›

subsubsection ‹get\_parent›

interpretation i_get_parent_wf?: l_get_parent_wfCore_DOM 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_wfCore_DOM_def)
declare l_get_parent_wfCore_DOM_axioms[instances]

lemma get_parent_wf_is_l_get_parent_wf [instances]:
  "l_get_parent_wf ShadowRootClass.type_wf ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
  heap_is_wellformed parent_child_rel Shadow_DOM.get_child_nodes Shadow_DOM.get_parent"
  apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def instances)[1]
  using child_parent_dual apply blast
  using heap_wellformed_induct apply metis
  using heap_wellformed_induct_rev apply metis
  using parent_child_rel_parent apply metis
  done



subsubsection ‹remove\_shadow\_root›

locale l_remove_shadow_root_wfShadow_DOM =
  l_get_tag_name +
  l_get_disconnected_nodes  +
  l_set_shadow_root_get_tag_name +
  l_get_child_nodes  +
  l_heap_is_wellformedShadow_DOM +
  l_remove_shadow_rootShadow_DOM +
  l_delete_shadow_root_get_disconnected_nodes +
  l_delete_shadow_root_get_child_nodes +
  l_set_shadow_root_get_disconnected_nodes +
  l_set_shadow_root_get_child_nodes +
  l_delete_shadow_root_get_tag_name +
  l_set_shadow_root_get_shadow_root +
  l_delete_shadow_root_get_shadow_root +
  l_get_parentCore_DOM
begin

lemma remove_shadow_root_preserves:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove_shadow_root ptr →h h'"
  shows "known_ptrs h'" and "type_wf h'" "heap_is_wellformed h'"
proof -
  obtain shadow_root_ptr h2 where
    "h ⊢ get_shadow_root ptr →r Some shadow_root_ptr" and
    "h ⊢ get_child_nodes (cast shadow_root_ptr) →r []" and
    h2: "h ⊢ set_shadow_root ptr None →h h2" and
    h': "h2 ⊢ delete_M shadow_root_ptr →h h'"
    using assms(4)
    by(auto simp add: remove_shadow_root_def
        elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
        split: option.splits if_splits)

  have "type_wf h2"
    using writes_small_big[where P="λh h'. type_wf h ⟶ type_wf h'", OF set_shadow_root_writes h2]
    using ‹type_wf h› set_shadow_root_types_preserved
    by(auto simp add: reflp_def transp_def)
  then show "type_wf h'"
    using h' delete_shadow_root_type_wf_preserved local.type_wf_impl
    by blast

  have object_ptr_kinds_eq_h: "object_ptr_kinds h = object_ptr_kinds h2"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
          OF set_shadow_root_writes h2])
    using set_shadow_root_pointers_preserved
      apply blast
    by (auto simp add: reflp_def transp_def)
  have node_ptr_kinds_eq_h: "node_ptr_kinds h = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h
    by (simp add: node_ptr_kinds_def)
  have element_ptr_kinds_eq_h: "element_ptr_kinds h = element_ptr_kinds h2"
    using node_ptr_kinds_eq_h
    by (simp add: element_ptr_kinds_def)
  have document_ptr_kinds_eq_h: "document_ptr_kinds h = document_ptr_kinds h2"
    using object_ptr_kinds_eq_h
    by (simp add: document_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h = shadow_root_ptr_kinds h2"
    using object_ptr_kinds_eq_h
    by (simp add: shadow_root_ptr_kinds_def)

  have "known_ptrs h2"
    using ‹known_ptrs h› object_ptr_kinds_eq_h known_ptrs_subset
    by blast

  have object_ptr_kinds_eq_h2: "object_ptr_kinds h' |⊆| object_ptr_kinds h2"
    using h' delete_shadow_root_pointers
    by auto
  have object_ptr_kinds_eq2_h2:
    "object_ptr_kinds h2 = object_ptr_kinds h' |∪| {|cast shadow_root_ptr|}"
    using h' delete_shadow_root_pointers
    by auto
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h2 = node_ptr_kinds h'"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def delete_shadow_root_pointers[OF h'])
  have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h'"
    using node_ptr_kinds_eq_h2
    by (simp add: element_ptr_kinds_def)
  have document_ptr_kinds_eq_h2: "document_ptr_kinds h2 = document_ptr_kinds h'"
    using object_ptr_kinds_eq_h2
    by(auto simp add: document_ptr_kinds_def delete_shadow_root_pointers[OF h'])
  have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h' |⊆| shadow_root_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by (auto simp add: shadow_root_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq2_h2:
    "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h' |∪| {|shadow_root_ptr|}"
    using object_ptr_kinds_eq2_h2
    by (auto simp add: shadow_root_ptr_kinds_def)

  show "known_ptrs h'"
    using object_ptr_kinds_eq_h2 ‹known_ptrs h2› known_ptrs_subset
    by blast


  have disconnected_nodes_eq_h:
    "⋀doc_ptr disc_nodes. h ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using get_disconnected_nodes_reads set_shadow_root_writes h2 set_shadow_root_get_disconnected_nodes
    by(rule reads_writes_preserved)
  then have disconnected_nodes_eq2_h:
    "⋀doc_ptr. |h ⊢ get_disconnected_nodes doc_ptr|r = |h2 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force

  have disconnected_nodes_eq_h2:
    "⋀doc_ptr disc_nodes. h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h' ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using get_disconnected_nodes_reads get_disconnected_nodes_delete_shadow_root[OF h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have disconnected_nodes_eq2_h2:
    "⋀doc_ptr. |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force

  have tag_name_eq_h:
    "⋀doc_ptr disc_nodes. h ⊢ get_tag_name doc_ptr →r disc_nodes =
      h2 ⊢ get_tag_name doc_ptr →r disc_nodes"
    using get_tag_name_reads set_shadow_root_writes h2 set_shadow_root_get_tag_name
    by(rule reads_writes_preserved)
  then have tag_name_eq2_h: "⋀doc_ptr. |h ⊢ get_tag_name doc_ptr|r = |h2 ⊢ get_tag_name doc_ptr|r"
    using select_result_eq by force

  have tag_name_eq_h2:
    "⋀doc_ptr disc_nodes. h2 ⊢ get_tag_name doc_ptr →r disc_nodes =
      h' ⊢ get_tag_name doc_ptr →r disc_nodes"
    using get_tag_name_reads get_tag_name_delete_shadow_root[OF h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have tag_name_eq2_h2: "⋀doc_ptr. |h2 ⊢ get_tag_name doc_ptr|r = |h' ⊢ get_tag_name doc_ptr|r"
    using select_result_eq by force


  have children_eq_h:
    "⋀ptr' children. h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using get_child_nodes_reads set_shadow_root_writes h2 set_shadow_root_get_child_nodes
    by(rule reads_writes_preserved)

  then have children_eq2_h: "⋀ptr'. |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force


  have children_eq_h2:
    "⋀ptr' children. ptr' ≠ cast shadow_root_ptr ⟹ h2 ⊢ get_child_nodes ptr' →r children =
      h' ⊢ get_child_nodes ptr' →r children"
    using get_child_nodes_reads h' get_child_nodes_delete_shadow_root
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h2:
    "⋀ptr'. ptr' ≠ cast shadow_root_ptr ⟹ |h2 ⊢ get_child_nodes ptr'|r =
    |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force

  have "cast shadow_root_ptr |∉| object_ptr_kinds h'"
    using h' deleteShadowRoot_M_ptr_not_in_heap
    by auto

  have get_shadow_root_eq_h:
    "⋀shadow_root_opt ptr'. ptr ≠ ptr' ⟹ h ⊢ get_shadow_root ptr' →r shadow_root_opt =
    h2 ⊢ get_shadow_root ptr' →r shadow_root_opt"
    using get_shadow_root_reads set_shadow_root_writes h2
    apply(rule reads_writes_preserved)
    using set_shadow_root_get_shadow_root_different_pointers
    by fast

  have get_shadow_root_eq_h2:
    "⋀shadow_root_opt ptr'. h2 ⊢ get_shadow_root ptr' →r shadow_root_opt =
    h' ⊢ get_shadow_root ptr' →r shadow_root_opt"
    using get_shadow_root_reads get_shadow_root_delete_shadow_root[OF h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then
  have get_shadow_root_eq2_h2: "⋀ptr'. |h2 ⊢ get_shadow_root ptr'|r =
    |h' ⊢ get_shadow_root ptr'|r"
    using select_result_eq by force



  have "acyclic (parent_child_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
  moreover
  have "parent_child_rel h = parent_child_rel h2"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h children_eq2_h)
  moreover
  have "parent_child_rel h' ⊆ parent_child_rel h2"
    using object_ptr_kinds_eq_h2
    apply(auto simp add: CD.parent_child_rel_def)[1]
    by (metis ‹castshadow_root_ptr2object_ptr shadow_root_ptr |∉| object_ptr_kinds h'› children_eq2_h2)
  ultimately
  have "CD.a_acyclic_heap h'"
    using acyclic_subset
    by (auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)

  moreover
  have "CD.a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_all_ptrs_in_heap h2"
    by(auto simp add: children_eq2_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h
        CD.a_all_ptrs_in_heap_def object_ptr_kinds_eq_h node_ptr_kinds_def
        children_eq_h disconnected_nodes_eq_h)
  then have "CD.a_all_ptrs_in_heap h'"
    using disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
    apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 children_eq_h2
         object_ptr_kinds_eq_h2)[1]
    by (metis (no_types, opaque_lifting) ‹castshadow_root_ptr2object_ptr shadow_root_ptr |∉| object_ptr_kinds h'›
        children_eq2_h2 fsubsetD in_mono object_ptr_kinds_eq_h2)

  moreover
  have "CD.a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_distinct_lists h2"
    by(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
        children_eq2_h disconnected_nodes_eq2_h)
  then have "CD.a_distinct_lists h'"
    apply(auto simp add: CD.a_distinct_lists_def document_ptr_kinds_eq_h2
        disconnected_nodes_eq2_h2)[1]
     apply(auto simp add:  intro!: distinct_concat_map_I)[1]
      apply(case_tac "x = cast shadow_root_ptr")
    using ‹cast shadow_root_ptr |∉| object_ptr_kinds h'› apply simp
    using children_eq_h2 concat_map_all_distinct[of "(λptr. |h2 ⊢ get_child_nodes ptr|r)"]
      apply (metis (no_types, lifting) children_eq2_h2 finite_fset fset_mp
        object_ptr_kinds_eq_h2 set_sorted_list_of_set)
     apply(case_tac "x = cast shadow_root_ptr")
    using ‹cast shadow_root_ptr |∉| object_ptr_kinds h'› apply simp
     apply(case_tac "y = cast shadow_root_ptr")
    using ‹cast shadow_root_ptr |∉| object_ptr_kinds h'› apply simp
    using children_eq_h2 distinct_concat_map_E(1)[of "(λptr. |h2 ⊢ get_child_nodes ptr|r)"]
     apply (metis (no_types, lifting) IntI ‹known_ptrs h'› ‹type_wf h'› children_eq2_h2 empty_iff
             finite_fset is_OK_returns_result_I l_get_child_nodes.get_child_nodes_ptr_in_heap
             local.get_child_nodes_ok local.known_ptrs_known_ptr local.l_get_child_nodes_axioms
             returns_result_select_result sorted_list_of_set.set_sorted_key_list_of_set)
    apply(case_tac "xa = cast shadow_root_ptr")
    using ‹cast shadow_root_ptr |∉| object_ptr_kinds h'› apply simp
    by (metis (mono_tags, lifting) CD.distinct_lists_no_parent ‹known_ptrs h'›
        ‹local.CD.a_distinct_lists h2› ‹type_wf h'› children_eq2_h2 children_eq_h2
        disconnected_nodes_eq_h2 is_OK_returns_result_I l_get_child_nodes.get_child_nodes_ptr_in_heap
        local.get_child_nodes_ok local.get_disconnected_nodes_ok local.known_ptrs_known_ptr
        local.l_get_child_nodes_axioms returns_result_select_result)
  moreover
  have "CD.a_owner_document_valid h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h2"
    by(auto simp add: CD.a_owner_document_valid_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
        node_ptr_kinds_eq_h children_eq2_h disconnected_nodes_eq2_h)
  then have "CD.a_owner_document_valid h'"
    apply(auto simp add: CD.a_owner_document_valid_def  document_ptr_kinds_eq_h2 node_ptr_kinds_eq_h2
        disconnected_nodes_eq2_h2)[1]
  proof -
    fix node_ptr
    assume 0: "∀node_ptr∈fset (node_ptr_kinds h').
      (∃document_ptr. document_ptr |∈| document_ptr_kinds h' ∧
      node_ptr ∈ set |h' ⊢ get_disconnected_nodes document_ptr|r) ∨
      (∃parent_ptr. parent_ptr |∈| object_ptr_kinds h2 ∧
      node_ptr ∈ set |h2 ⊢ get_child_nodes parent_ptr|r)"
      and 1: "node_ptr |∈| node_ptr_kinds h'"
      and 2: "∀parent_ptr. parent_ptr |∈| object_ptr_kinds h' ⟶
        node_ptr ∉ set |h' ⊢ get_child_nodes parent_ptr|r"
    then have "∀parent_ptr. parent_ptr |∈| object_ptr_kinds h2 ⟶
      node_ptr ∉ set |h2 ⊢ get_child_nodes parent_ptr|r"
      apply(auto)[1]
      apply(case_tac "parent_ptr = cast shadow_root_ptr")
      using ‹h ⊢ get_child_nodes (cast shadow_root_ptr) →r []› children_eq_h
       apply auto[1]
      using children_eq2_h2 object_ptr_kinds_eq_h2 h' delete_shadow_root_pointers
      by (metis fempty_iff finsert_iff funionE)
    then show "∃document_ptr. document_ptr |∈| document_ptr_kinds h' ∧
      node_ptr ∈ set |h' ⊢ get_disconnected_nodes document_ptr|r"
      using 0 1
      by auto
  qed

  ultimately have "heap_is_wellformedCore_DOM h'"
    by(simp add: CD.heap_is_wellformed_def)

  moreover
  have "acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using ‹heap_is_wellformed h›
    by(simp add: heap_is_wellformed_def)
  then
  have "acyclic (parent_child_rel h2 ∪ a_host_shadow_root_rel h2)"
  proof -
    have "a_host_shadow_root_rel h2 ⊆ a_host_shadow_root_rel h"
      apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h)[1]
      apply(case_tac "aa = ptr")
       apply(simp)
       apply (metis (no_types, lifting) ‹type_wf h2› assms(2) h2 local.get_shadow_root_ok
          local.type_wf_impl option.distinct(1) returns_result_eq
          returns_result_select_result set_shadow_root_get_shadow_root)
      using get_shadow_root_eq_h
      by (metis (mono_tags, lifting) ‹type_wf h2› image_eqI is_OK_returns_result_E
          local.get_shadow_root_ok mem_Collect_eq prod.simps(2) select_result_I2)
    then show ?thesis
      using ‹parent_child_rel h = parent_child_rel h2›
      by (metis (no_types, opaque_lifting) ‹acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)›
          acyclic_subset order_refl sup_mono)
  qed
  then
  have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
  proof -
    have "a_host_shadow_root_rel h' ⊆ a_host_shadow_root_rel h2"
      by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 get_shadow_root_eq2_h2)
    then show ?thesis
      using ‹parent_child_rel h' ⊆ parent_child_rel h2›
        ‹acyclic (parent_child_rel h2 ∪ a_host_shadow_root_rel h2)›
      using acyclic_subset sup_mono
      by (metis (no_types, opaque_lifting))
  qed

  moreover
  have "a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›
    by(simp add: heap_is_wellformed_def)
  then
  have "a_all_ptrs_in_heap h2"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
    apply(case_tac "host = ptr")
     apply(simp)
     apply (metis assms(2) h2 local.type_wf_impl option.distinct(1) returns_result_eq
        set_shadow_root_get_shadow_root)
    using get_shadow_root_eq_h
    by fastforce
  then
  have "a_all_ptrs_in_heap h'"
    apply(auto simp add: a_all_ptrs_in_heap_def get_shadow_root_eq_h2)[1]
    apply(auto simp add: shadow_root_ptr_kinds_eq2_h2)[1]
    by (metis (no_types, lifting) ‹h ⊢ get_shadow_root ptr →r Some shadow_root_ptr› assms(1)
        assms(2) get_shadow_root_eq_h get_shadow_root_eq_h2 h2 local.shadow_root_same_host
        local.type_wf_impl option.distinct(1) select_result_I2 set_shadow_root_get_shadow_root)

  moreover
  have "a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by(simp add: heap_is_wellformed_def)
  then
  have "a_distinct_lists h2"
    apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h)[1]
    apply(auto intro!: distinct_concat_map_I split: option.splits)[1]
    apply(case_tac "x = ptr")
     apply(simp)
     apply (metis (no_types, opaque_lifting) assms(2) h2 is_OK_returns_result_I
        l_set_shadow_root_get_shadow_root.set_shadow_root_get_shadow_root
        l_set_shadow_root_get_shadow_root_axioms local.type_wf_impl option.discI
        returns_result_eq returns_result_select_result)

    apply(case_tac "y = ptr")
     apply(simp)
     apply (metis (no_types, opaque_lifting) assms(2) h2 is_OK_returns_result_I
        l_set_shadow_root_get_shadow_root.set_shadow_root_get_shadow_root
        l_set_shadow_root_get_shadow_root_axioms local.type_wf_impl option.discI
        returns_result_eq returns_result_select_result)
    by (metis ‹type_wf h2› assms(1) assms(2) get_shadow_root_eq_h local.get_shadow_root_ok
        local.shadow_root_same_host returns_result_select_result)

  then
  have "a_distinct_lists h'"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2 get_shadow_root_eq2_h2)

  moreover
  have "a_shadow_root_valid h"
    using ‹heap_is_wellformed h›
    by(simp add: heap_is_wellformed_def)
  then
  have "a_shadow_root_valid h'"
    by (smt (verit) ‹h ⊢ get_shadow_root ptr →r Some shadow_root_ptr› assms(2)
        deleteShadowRoot_M_ptr_not_in_heap element_ptr_kinds_eq_h element_ptr_kinds_eq_h2
        finsert_iff funion_finsert_right get_shadow_root_eq2_h2 get_shadow_root_eq_h h'
        local.a_shadow_root_valid_def local.get_shadow_root_ok object_ptr_kinds_eq2_h2
        object_ptr_kinds_eq_h option.sel returns_result_select_result select_result_I2
        shadow_root_ptr_kinds_commutes sup_bot.right_neutral tag_name_eq2_h tag_name_eq2_h2)
  ultimately show "heap_is_wellformed h'"
    by(simp add: heap_is_wellformed_def)
qed
end

interpretation i_remove_shadow_root_wf?: l_remove_shadow_root_wfShadow_DOM
  type_wf get_tag_name get_tag_name_locs get_disconnected_nodes get_disconnected_nodes_locs
  set_shadow_root set_shadow_root_locs known_ptr get_child_nodes get_child_nodes_locs get_shadow_root
  get_shadow_root_locs heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_host
  get_host_locs get_disconnected_document get_disconnected_document_locs remove_shadow_root
  remove_shadow_root_locs known_ptrs get_parent get_parent_locs
  by(auto simp add: l_remove_shadow_root_wfShadow_DOM_def instances)
declare l_remove_shadow_root_wfShadow_DOM_axioms [instances]


subsubsection ‹get\_root\_node›

interpretation i_get_root_node_wf?: l_get_root_node_wfCore_DOM known_ptr type_wf known_ptrs
  heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs
  get_root_node get_root_node_locs
  by(simp add: l_get_root_node_wfCore_DOM_def instances)
declare l_get_root_node_wfCore_DOM_axioms[instances]

lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]:
  "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors
  get_ancestors_locs get_child_nodes get_parent"
  apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def instances)[1]
  using get_ancestors_never_empty apply blast
  using get_ancestors_ok apply blast
  using get_ancestors_reads apply blast
  using get_ancestors_ptrs_in_heap apply blast
  using get_ancestors_remains_not_in_ancestors apply blast
  using get_ancestors_also_parent apply blast
  using get_ancestors_obtains_children apply blast
  using get_ancestors_parent_child_rel apply blast
  using get_ancestors_parent_child_rel apply blast
  done

lemma get_root_node_wf_is_l_get_root_node_wf [instances]:
  "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs get_ancestors
    get_parent"
  using known_ptrs_is_l_known_ptrs
  apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def)[1]
  using get_root_node_ok apply blast
  using get_root_node_ptr_in_heap apply blast
  using get_root_node_root_in_heap apply blast
  using get_ancestors_same_root_node apply(blast, blast)
  using get_root_node_same_no_parent apply blast
    (* using get_root_node_not_node_same apply blast *)
  using get_root_node_parent_same apply (blast, blast)
  done

subsubsection ‹get\_parent\_get\_host›

locale l_get_parent_get_host_wfShadow_DOM =
  l_heap_is_wellformedShadow_DOM +
  l_get_parent_wf +
  l_get_shadow_root +
  l_get_host +
  l_get_child_nodes
begin
lemma host_shadow_root_rel_finite: "finite (a_host_shadow_root_rel h)"
proof -
  have "a_host_shadow_root_rel h = (⋃host ∈ fset (element_ptr_kinds h).
    (case |h ⊢ get_shadow_root host|r of
    Some shadow_root ⇒ {(cast host, cast shadow_root)} | None ⇒ {}))"
    by(auto simp add: a_host_shadow_root_rel_def split: option.splits)
  moreover have "finite (⋃host ∈ fset (element_ptr_kinds h).
    (case |h ⊢ get_shadow_root host|r of
    Some shadow_root ⇒ {(castelement_ptr2object_ptr host, castshadow_root_ptr2object_ptr shadow_root)} |
    None ⇒ {}))"
    by(auto split: option.splits)
  ultimately show ?thesis
    by auto
qed

lemma host_shadow_root_rel_shadow_root:
  "h ⊢ get_shadow_root host →r shadow_root_option ⟹
   shadow_root_option = Some shadow_root ⟷ ((cast host, cast shadow_root) ∈ a_host_shadow_root_rel h)"
  apply(auto simp add: a_host_shadow_root_rel_def)[1]
  by(metis (mono_tags, lifting) case_prodI is_OK_returns_result_I
      l_get_shadow_root.get_shadow_root_ptr_in_heap local.l_get_shadow_root_axioms
      mem_Collect_eq pair_imageI select_result_I2)

lemma host_shadow_root_rel_host:
  "heap_is_wellformed h ⟹ h ⊢ get_host shadow_root →r host ⟹
  (cast host, cast shadow_root) ∈ a_host_shadow_root_rel h"
  apply(auto simp add: a_host_shadow_root_rel_def)[1]
  using shadow_root_host_dual
  by (metis (no_types, lifting) Collect_cong host_shadow_root_rel_shadow_root
      local.a_host_shadow_root_rel_def split_cong)

lemma heap_wellformed_induct_si [consumes 1, case_names step]:
  assumes "heap_is_wellformed h"
  assumes "⋀parent. (⋀children child. h ⊢ get_child_nodes parent →r children ⟹
    child ∈ set children ⟹ P (cast child)) ⟹ (⋀shadow_root host. parent = cast host ⟹
      h ⊢ get_shadow_root host →r Some shadow_root ⟹  P (cast shadow_root)) ⟹ P parent"
  shows "P ptr"
proof -
  fix ptr
  have "finite (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using host_shadow_root_rel_finite
    using local.CD.parent_child_rel_finite local.CD.parent_child_rel_impl
    by auto
  then
  have "wf ((parent_child_rel h ∪ a_host_shadow_root_rel h)¯)"
    using assms(1)
    apply(simp add: heap_is_wellformed_def)
    by (simp add: finite_acyclic_wf_converse local.CD.parent_child_rel_impl)
  then show "?thesis"
  proof (induct rule: wf_induct_rule)
    case (less parent)
    then show ?case
      apply(auto)[1]
      using assms host_shadow_root_rel_shadow_root local.CD.parent_child_rel_child
      by blast
  qed
qed

lemma heap_wellformed_induct_rev_si [consumes 1, case_names step]:
  assumes "heap_is_wellformed h"
  assumes "⋀child. (⋀parent child_node. child = cast child_node ⟹
    h ⊢ get_parent child_node →r Some parent ⟹ P parent) ⟹
    (⋀host shadow_root. child = cast shadow_root ⟹ h ⊢ get_host shadow_root →r host ⟹
    P (cast host)) ⟹ P child"
  shows "P ptr"
proof -
  fix ptr
  have "finite (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using host_shadow_root_rel_finite
    using local.CD.parent_child_rel_finite local.CD.parent_child_rel_impl
    by auto
  then
  have "wf (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using assms(1)
    apply(simp add: heap_is_wellformed_def)
    by (simp add: finite_acyclic_wf)
  then show "?thesis"
  proof (induct rule: wf_induct_rule)
    case (less parent)
    then show ?case
      apply(auto)[1]
      using parent_child_rel_parent host_shadow_root_rel_host
      using assms(1) assms(2) by auto
  qed
qed
end

interpretation i_get_parent_get_host_wf?: l_get_parent_get_host_wfShadow_DOM
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_host get_host_locs
  get_disconnected_document get_disconnected_document_locs known_ptrs get_parent get_parent_locs
  by(auto simp add: l_get_parent_get_host_wfShadow_DOM_def instances)
declare l_get_parent_get_host_wfShadow_DOM_axioms [instances]


locale l_get_parent_get_host_wf =
  l_heap_is_wellformed_defs +
  l_get_parent_defs +
  l_get_shadow_root_defs +
  l_get_host_defs +
  l_get_child_nodes_defs +
  assumes heap_wellformed_induct_si [consumes 1, case_names step]:
    "heap_is_wellformed h
    ⟹ (⋀parent. (⋀children child. h ⊢ get_child_nodes parent →r children ⟹ child ∈ set children
      ⟹ P (cast child))
        ⟹ (⋀shadow_root host. parent = cast host ⟹ h ⊢ get_shadow_root host →r Some shadow_root
    ⟹  P (cast shadow_root))
      ⟹ P parent)
    ⟹ P ptr"
  assumes heap_wellformed_induct_rev_si [consumes 1, case_names step]:
    "heap_is_wellformed h
    ⟹ (⋀child. (⋀parent child_node. child = cast child_node ⟹
      h ⊢ get_parent child_node →r Some parent ⟹ P parent)
      ⟹ (⋀host shadow_root. child = cast shadow_root ⟹ h ⊢ get_host shadow_root →r host
    ⟹ P (cast host))
      ⟹ P child)
    ⟹ P ptr"

lemma l_get_parent_get_host_wf_is_get_parent_get_host_wf [instances]:
  "l_get_parent_get_host_wf heap_is_wellformed get_parent get_shadow_root get_host get_child_nodes"
  apply(auto simp add: l_get_parent_get_host_wf_def instances)[1]
  using heap_wellformed_induct_si apply metis
  using heap_wellformed_induct_rev_si apply blast
  done


subsubsection ‹get\_host›

locale l_get_host_wfShadow_DOM =
  l_heap_is_wellformedShadow_DOM  get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
  known_ptr type_wf heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_host
  get_host_locs +
  l_type_wf type_wf +
  l_get_hostShadow_DOM get_shadow_root get_shadow_root_locs get_host get_host_locs type_wf +
  l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and known_ptrs :: "(_) heap ⇒ bool"
    and type_wf :: "(_) heap ⇒ bool"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformed :: "(_) heap ⇒ bool"
    and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
    and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
begin

lemma get_host_ok [simp]:
  assumes "heap_is_wellformed h"
  assumes "type_wf h"
  assumes "known_ptrs h"
  assumes "shadow_root_ptr |∈| shadow_root_ptr_kinds h"
  shows "h ⊢ ok (get_host shadow_root_ptr)"
proof -
  obtain host where host: "host |∈| element_ptr_kinds h"
    and "|h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types"
    and shadow_root: "h ⊢ get_shadow_root host →r Some shadow_root_ptr"
    using assms(1) assms(4) get_shadow_root_ok assms(2)
    apply(auto simp add: heap_is_wellformed_def a_shadow_root_valid_def)[1]
    by (smt returns_result_select_result)


  obtain host_candidates where
    host_candidates: "h ⊢ filter_M (λelement_ptr. Heap_Error_Monad.bind (get_shadow_root element_ptr)
      (λshadow_root_opt. return (shadow_root_opt = Some shadow_root_ptr)))
                (sorted_list_of_set (fset (element_ptr_kinds h)))
          →r host_candidates"
    apply(drule is_OK_returns_result_E[rotated])
    using get_shadow_root_ok assms(2)
    by(auto intro!: filter_M_is_OK_I bind_pure_I bind_is_OK_I2)
  then have "host_candidates = [host]"
    apply(rule filter_M_ex1)
        apply (simp add: host)
       apply (smt (verit) assms(1) assms(2) bind_pure_returns_result_I2 finite_fset
               host local.get_shadow_root_ok local.get_shadow_root_pure local.shadow_root_same_host
               return_returns_result returns_result_eq shadow_root sorted_list_of_set(1))
    by (simp_all add: assms(2) bind_pure_I bind_pure_returns_result_I2 host local.get_shadow_root_ok
        returns_result_eq shadow_root)
  then
  show ?thesis
    using host_candidates host assms(1) get_shadow_root_ok
    apply(auto simp add: get_host_def known_ptrs_known_ptr
        intro!: bind_is_OK_pure_I filter_M_pure_I filter_M_is_OK_I bind_pure_I split: list.splits)[1]
    using assms(2) apply blast
     apply (meson list.distinct(1) returns_result_eq)
    by (meson list.distinct(1) list.inject returns_result_eq)
qed
end

interpretation i_get_host_wf?: l_get_host_wfShadow_DOM get_disconnected_document
  get_disconnected_document_locs known_ptr known_ptrs type_wf get_host get_host_locs get_shadow_root
  get_shadow_root_locs get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM
  by(auto simp add: l_get_host_wfShadow_DOM_def instances)
declare l_get_host_wfShadow_DOM_axioms [instances]

locale l_get_host_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_host_defs +
  assumes get_host_ok:
    "heap_is_wellformed h ⟹ known_ptrs h ⟹ type_wf h ⟹
    shadow_root_ptr |∈| shadow_root_ptr_kinds h ⟹ h ⊢ ok (get_host shadow_root_ptr)"

lemma get_host_wf_is_l_get_host_wf [instances]:
  "l_get_host_wf heap_is_wellformed known_ptr known_ptrs type_wf get_host"
  by(auto simp add: l_get_host_wf_def l_get_host_wf_axioms_def instances)


subsubsection ‹get\_root\_node\_si›

locale l_get_root_node_si_wfShadow_DOM =
  l_get_root_node_siShadow_DOM +
  l_heap_is_wellformedShadow_DOM +
  l_get_parent_wf +
  l_get_parent_get_host_wf +
  l_get_host_wf
begin
lemma get_root_node_si_ptr_in_heap:
  assumes "h ⊢ ok (get_root_node_si ptr)"
  shows "ptr |∈| object_ptr_kinds h"
  using assms
  unfolding get_root_node_si_def
  using get_ancestors_si_ptr_in_heap
  by auto


lemma get_ancestors_si_ok:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
    and "ptr |∈| object_ptr_kinds h"
  shows "h ⊢ ok (get_ancestors_si ptr)"
proof (insert assms(1) assms(4), induct rule: heap_wellformed_induct_rev_si)
  case (step child)
  then show ?case
    using assms(2) assms(3)
    apply(auto simp add: get_ancestors_si_def[of child] assms(1) get_parent_parent_in_heap
        intro!: bind_is_OK_pure_I
        split: option.splits)[1]
    using local.get_parent_ok apply blast
    using get_host_ok assms(1) apply blast
    by (meson assms(1) is_OK_returns_result_I local.get_shadow_root_ptr_in_heap
        local.shadow_root_host_dual)
qed

lemma get_ancestors_si_remains_not_in_ancestors:
  assumes "heap_is_wellformed h"
    and "heap_is_wellformed h'"
    and "h ⊢ get_ancestors_si ptr →r ancestors"
    and "h' ⊢ get_ancestors_si ptr →r ancestors'"
    and "⋀p children children'. h ⊢ get_child_nodes p →r children
        ⟹ h' ⊢ get_child_nodes p →r children' ⟹ set children' ⊆ set children"
    and "⋀p shadow_root_option shadow_root_option'. h ⊢ get_shadow_root p →r shadow_root_option ⟹
        h' ⊢ get_shadow_root p →r shadow_root_option' ⟹ (if shadow_root_option = None
        then shadow_root_option' = None else shadow_root_option' = None ∨
          shadow_root_option' = shadow_root_option)"
    and "node ∉ 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 ∉ set ancestors'"
proof -
  have object_ptr_kinds_M_eq:
    "⋀ptrs. h ⊢ object_ptr_kinds_M →r ptrs = h' ⊢ object_ptr_kinds_M →r ptrs"
    using object_ptr_kinds_eq3
    by(simp add: object_ptr_kinds_M_defs)
  then have object_ptr_kinds_eq: "|h ⊢ object_ptr_kinds_M|r = |h' ⊢ object_ptr_kinds_M|r"
    by(simp)

  show ?thesis
  proof (insert assms(1) assms(3) assms(4) assms(7), induct ptr arbitrary: ancestors ancestors'
      rule: heap_wellformed_induct_rev_si)
    case (step child)

    obtain ancestors_remains where ancestors_remains:
      "ancestors = child # ancestors_remains"
      using ‹h ⊢ get_ancestors_si child →r ancestors› get_ancestors_si_never_empty
      by(auto simp add: get_ancestors_si_def[of child]
          elim!: bind_returns_result_E2
          split: option.splits)
    obtain ancestors_remains' where ancestors_remains':
      "ancestors' = child # ancestors_remains'"
      using ‹h' ⊢ get_ancestors_si child →r ancestors'› get_ancestors_si_never_empty
      by(auto simp add: get_ancestors_si_def[of child]
          elim!: bind_returns_result_E2
          split: option.splits)
    have "child |∈| object_ptr_kinds h"
      using local.get_ancestors_si_ptr_in_heap object_ptr_kinds_eq3 step.prems(2) by fastforce

    have "node ≠ child"
      using ancestors_remains step.prems(3) by auto

    have 1: "⋀p parent. h' ⊢ get_parent p →r Some parent ⟹ h ⊢ get_parent p →r Some parent"
    proof -
      fix p parent
      assume "h' ⊢ get_parent p →r Some parent"
      then obtain children' where
        children': "h' ⊢ get_child_nodes parent →r children'" and
        p_in_children': "p ∈ set children'"
        using get_parent_child_dual by blast
      obtain children where children: "h ⊢ get_child_nodes parent →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 ‹h' ⊢ get_parent p →r Some parent› get_parent_parent_in_heap is_OK_returns_result_E
            local.known_ptrs_known_ptr object_ptr_kinds_eq3)
      have "p ∈ set children"
        using assms(5) children children' p_in_children'
        by blast
      then show "h ⊢ get_parent p →r Some parent"
        using child_parent_dual assms(1) children known_ptrs  type_wf  by blast
    qed

    have 2: "⋀p host. h' ⊢ get_host p →r host ⟹ h ⊢ get_host p →r host"
    proof -
      fix p host
      assume "h' ⊢ get_host p →r host"
      then have "h' ⊢ get_shadow_root host →r Some p"
        using local.shadow_root_host_dual by blast
      then have "h ⊢ get_shadow_root host →r Some p"
        by (metis assms(6) element_ptr_kinds_commutes is_OK_returns_result_I local.get_shadow_root_ok
            local.get_shadow_root_ptr_in_heap node_ptr_kinds_commutes object_ptr_kinds_eq3
            option.distinct(1) returns_result_select_result type_wf)
      then show "h ⊢ get_host p →r host"
        by (metis assms(1) is_OK_returns_result_E known_ptrs local.get_host_ok
            local.get_shadow_root_shadow_root_ptr_in_heap local.shadow_root_host_dual
            local.shadow_root_same_host type_wf)

    qed


    show ?case
    proof (cases "castobject_ptr2node_ptr child")
      case None
      then show ?thesis
        using step(3) step(4) ‹node ≠ child›
        apply(auto simp add: get_ancestors_si_def[of child]
            elim!: bind_returns_result_E2
            split: option.splits)[1]
        by (metis "2" assms(1) l_heap_is_wellformedShadow_DOM.shadow_root_same_host list.set_intros(2)
            local.l_heap_is_wellformedShadow_DOM_axioms local.shadow_root_host_dual step.hyps(2)
            step.prems(3) type_wf)
    next
      case (Some node_child)
      then
      show ?thesis
        using step(3) step(4) ‹node ≠ child›
        apply(auto simp add: get_ancestors_si_def[of child]
            elim!: bind_returns_result_E2
            split: option.splits)[1]
         apply (meson "1" option.distinct(1) returns_result_eq)
        by (metis "1" list.set_intros(2) option.inject returns_result_eq step.hyps(1) step.prems(3))
    qed
  qed
qed


lemma get_ancestors_si_ptrs_in_heap:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ get_ancestors_si ptr →r ancestors"
  assumes "ptr' ∈ set ancestors"
  shows "ptr' |∈| 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 ⊢ get_ancestors_si x →r a # ancestors"
    by(auto simp add: get_ancestors_si_def[of a] elim!: bind_returns_result_E2 split: option.splits)
  then have "x = a"
    by(auto simp add: get_ancestors_si_def[of x] elim!: bind_returns_result_E2 split: option.splits)
  then show ?case
  proof (cases "ptr' = a")
    case True
    then show ?thesis
      using Cons.hyps Cons.prems(2) get_ancestors_si_ptr_in_heap x
      using ‹x = a› by blast
  next
    case False
    obtain ptr'' where ptr'': "h ⊢ get_ancestors_si ptr'' →r ancestors"
      using ‹ h ⊢ get_ancestors_si x →r a # ancestors› Cons.prems(2) False
      by(auto simp add: get_ancestors_si_def[of x] elim!: bind_returns_result_E2 split: option.splits)
    then show ?thesis
      using Cons.hyps Cons.prems(2) False by auto
  qed
qed

lemma get_ancestors_si_reads:
  assumes "heap_is_wellformed h"
  shows "reads get_ancestors_si_locs (get_ancestors_si node_ptr) h h'"
proof (insert assms(1), induct rule: heap_wellformed_induct_rev_si)
  case (step child)
  then show ?case
    using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def]
      get_host_reads[unfolded reads_def]
    apply(simp (no_asm) add: get_ancestors_si_def)
    by(auto simp add: get_ancestors_si_locs_def get_parent_reads_pointers
        intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
        reads_subset[OF return_reads] reads_subset[OF get_parent_reads]
        reads_subset[OF get_child_nodes_reads] reads_subset[OF get_host_reads]
        split: option.splits)
qed


lemma get_ancestors_si_subset:
  assumes "heap_is_wellformed h"
    and "h ⊢ get_ancestors_si ptr →r ancestors"
    and "ancestor ∈ set ancestors"
    and "h ⊢ get_ancestors_si ancestor →r ancestor_ancestors"
    and type_wf: "type_wf h"
    and known_ptrs: "known_ptrs h"
  shows "set ancestor_ancestors ⊆ set ancestors"
proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors
    rule: heap_wellformed_induct_rev_si)
  case (step child)
  have "child |∈| object_ptr_kinds h"
    using get_ancestors_si_ptr_in_heap step(3) by auto
      (*  then have "h ⊢ check_in_heap child →r ()"
    using returns_result_select_result by force *)


  obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
    using step(3)
    by(auto simp add: get_ancestors_si_def[of child] intro!: bind_pure_I
        elim!: bind_returns_result_E2 split: option.splits)
  show ?case
  proof (induct "castobject_ptr2node_ptr child")
    case None
    show ?case
    proof (induct "castobject_ptr2shadow_root_ptr child")
      case None
      then show ?case
        using step(3) ‹None = castobject_ptr2node_ptr child›
        apply(auto simp add: get_ancestors_si_def[of child] elim!: bind_returns_result_E2)[1]
        by (metis (no_types, lifting) assms(4) empty_iff empty_set select_result_I2 set_ConsD
            step.prems(1) step.prems(2))
    next
      case (Some shadow_root_child)
      then
      have "shadow_root_child |∈| shadow_root_ptr_kinds h"
        using  ‹child |∈| object_ptr_kinds h›
        by (metis (no_types, lifting) shadow_root_ptr_casts_commute shadow_root_ptr_kinds_commutes)
      obtain host where host: "h ⊢ get_host shadow_root_child →r host"
        using get_host_ok assms
        by (meson ‹shadow_root_child |∈| shadow_root_ptr_kinds h› is_OK_returns_result_E)
      then
      have "h ⊢ get_ancestors_si (cast host) →r tl_ancestors"
        using Some step(3) tl_ancestors None
        by(auto simp add: get_ancestors_si_def[of child] intro!: bind_pure_returns_result_I
            elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
      then
      show ?case
        using step(2) Some host step(4) tl_ancestors
        by (metis (no_types, lifting) assms(4) dual_order.trans eq_iff returns_result_eq set_ConsD
            set_subset_Cons shadow_root_ptr_casts_commute step.prems(1))
    qed
  next
    case (Some child_node)
    note s1 = Some
    obtain parent_opt where parent_opt: "h ⊢ get_parent child_node →r parent_opt"
      using ‹child |∈| object_ptr_kinds h› 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_parentCore_DOM_axioms node_ptr_casts_commute node_ptr_kinds_commutes)
    then show ?case
    proof (induct parent_opt)
      case None
      then have "ancestors = [child]"
        using step(3) s1
        apply(simp add: get_ancestors_si_def)
        by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
      show ?case
        using step(3) step(4)
        apply(auto simp add: ‹ancestors = [child]›)[1]
        using assms(4) returns_result_eq by fastforce
    next
      case (Some parent)
      then
      have "h ⊢ get_ancestors_si parent →r tl_ancestors"
        using s1 tl_ancestors step(3)
        by(auto simp add: get_ancestors_si_def[of child]
            elim!: bind_returns_result_E2
            split: option.splits dest: returns_result_eq)
      show ?case
        by (metis (no_types, lifting) Some.prems ‹h ⊢ get_ancestors_si parent →r tl_ancestors›
            assms(4) eq_iff node_ptr_casts_commute order_trans s1 select_result_I2 set_ConsD
            set_subset_Cons step.hyps(1) step.prems(1) step.prems(2) tl_ancestors)
    qed
  qed
qed

lemma get_ancestors_si_also_parent:
  assumes "heap_is_wellformed h"
    and "h ⊢ get_ancestors_si some_ptr →r ancestors"
    and "cast child ∈ set ancestors"
    and "h ⊢ get_parent child →r Some parent"
    and type_wf: "type_wf h"
    and known_ptrs: "known_ptrs h"
  shows "parent ∈ set ancestors"
proof -
  obtain child_ancestors where child_ancestors:
    "h ⊢ get_ancestors_si (cast child) →r child_ancestors"
    by (meson assms(1) assms(4) get_ancestors_si_ok is_OK_returns_result_I known_ptrs
        local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result
        type_wf)
  then have "parent ∈ set child_ancestors"
    apply(simp add: get_ancestors_si_def)
    by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
        get_ancestors_si_ptr)
  then show ?thesis
    using assms child_ancestors get_ancestors_si_subset by blast
qed

lemma get_ancestors_si_also_host:
  assumes "heap_is_wellformed h"
    and "h ⊢ get_ancestors_si some_ptr →r ancestors"
    and "cast shadow_root ∈ set ancestors"
    and "h ⊢ get_host shadow_root →r host"
    and type_wf: "type_wf h"
    and known_ptrs: "known_ptrs h"
  shows "cast host ∈ set ancestors"
proof -
  obtain child_ancestors where child_ancestors:
    "h ⊢ get_ancestors_si (cast shadow_root) →r child_ancestors"
    by (meson assms(1) assms(2) assms(3) get_ancestors_si_ok get_ancestors_si_ptrs_in_heap
        is_OK_returns_result_E known_ptrs type_wf)
  then have "cast host ∈ set child_ancestors"
    apply(simp add: get_ancestors_si_def)
    by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
        get_ancestors_si_ptr)
  then show ?thesis
    using assms child_ancestors get_ancestors_si_subset by blast
qed

lemma get_ancestors_si_parent_child_rel:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
  assumes "h ⊢ get_ancestors_si child →r ancestors"
  assumes "((ptr, child) ∈ (parent_child_rel h)*)"
  shows "ptr ∈ set ancestors"
proof (insert assms(5), induct ptr rule: heap_wellformed_induct_si[OF assms(1)])
  case (1 ptr)
  then show ?case
  proof (cases "ptr = child")
    case True
    then show ?thesis
      using assms(4) local.get_ancestors_si_ptr by blast
  next
    case False
    obtain ptr_child where
      ptr_child: "(ptr, ptr_child) ∈ (parent_child_rel h) ∧ (ptr_child, child) ∈ (parent_child_rel h)*"
      using converse_rtranclE[OF 1(3)] ‹ptr ≠ child›
      by metis
    then obtain ptr_child_node
      where ptr_child_ptr_child_node: "ptr_child = castnode_ptr2object_ptr ptr_child_node"
      using ptr_child node_ptr_casts_commute3 CD.parent_child_rel_node_ptr
      by (metis )
    then obtain children where
      children: "h ⊢ get_child_nodes ptr →r children" and
      ptr_child_node: "ptr_child_node ∈ set children"
    proof -
      assume a1: "⋀children. ⟦h ⊢ get_child_nodes ptr →r children; ptr_child_node ∈ set children⟧
                   ⟹ thesis"

      have "ptr |∈| object_ptr_kinds h"
        using CD.parent_child_rel_parent_in_heap ptr_child by blast
      moreover have "ptr_child_node ∈ set |h ⊢ get_child_nodes ptr|r"
        by (metis calculation ‹known_ptrs h› local.get_child_nodes_ok local.known_ptrs_known_ptr
            CD.parent_child_rel_child ptr_child ptr_child_ptr_child_node
            returns_result_select_result ‹type_wf h›)
      ultimately show ?thesis
        using a1 get_child_nodes_ok ‹type_wf h› ‹known_ptrs h›
        by (meson local.known_ptrs_known_ptr returns_result_select_result)
    qed
    moreover have "(castnode_ptr2object_ptr ptr_child_node, child) ∈ (parent_child_rel h)*"
      using ptr_child ptr_child_ptr_child_node by auto
    ultimately have "castnode_ptr2object_ptr ptr_child_node ∈ set ancestors"
      using 1 by auto
    moreover have "h ⊢ get_parent ptr_child_node →r Some ptr"
      using assms(1) children ptr_child_node child_parent_dual
      using ‹known_ptrs h› ‹type_wf h› by blast
    ultimately show ?thesis
      using get_ancestors_si_also_parent assms ‹type_wf h› by blast
  qed
qed

lemma get_ancestors_si_parent_child_host_shadow_root_rel:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
  assumes "h ⊢ get_ancestors_si child →r ancestors"
  assumes "((ptr, child) ∈ (parent_child_rel h ∪ a_host_shadow_root_rel h)*)"
  shows "ptr ∈ set ancestors"
proof (insert assms(5), induct ptr rule: heap_wellformed_induct_si[OF assms(1)])
  case (1 ptr)
  then show ?case
  proof (cases "ptr = child")
    case True
    then show ?thesis
      using assms(4) local.get_ancestors_si_ptr by blast
  next
    case False

    obtain ptr_child where
      ptr_child: "(ptr, ptr_child) ∈ (parent_child_rel h ∪ local.a_host_shadow_root_rel h) ∧
          (ptr_child, child) ∈ (parent_child_rel h ∪ local.a_host_shadow_root_rel h)*"
      using converse_rtranclE[OF 1(3)] ‹ptr ≠ child›
      by metis
    then show ?thesis
    proof(cases "(ptr, ptr_child) ∈ parent_child_rel h")
      case True

      then obtain ptr_child_node
        where ptr_child_ptr_child_node: "ptr_child = castnode_ptr2object_ptr ptr_child_node"
        using ptr_child node_ptr_casts_commute3 CD.parent_child_rel_node_ptr
        by (metis)
      then obtain children where
        children: "h ⊢ get_child_nodes ptr →r children" and
        ptr_child_node: "ptr_child_node ∈ set children"
      proof -
        assume a1: "⋀children. ⟦h ⊢ get_child_nodes ptr →r children; ptr_child_node ∈ set children⟧
                   ⟹ thesis"

        have "ptr |∈| object_ptr_kinds h"
          using CD.parent_child_rel_parent_in_heap True by blast
        moreover have "ptr_child_node ∈ set |h ⊢ get_child_nodes ptr|r"
          by (metis True assms(2) assms(3) calculation local.CD.parent_child_rel_child
              local.get_child_nodes_ok local.known_ptrs_known_ptr ptr_child_ptr_child_node
              returns_result_select_result)
        ultimately show ?thesis
          using a1 get_child_nodes_ok ‹type_wf h› ‹known_ptrs h›
          by (meson local.known_ptrs_known_ptr returns_result_select_result)
      qed
      moreover have "(castnode_ptr2object_ptr ptr_child_node, child) ∈
          (parent_child_rel h ∪ local.a_host_shadow_root_rel h)*"
        using ptr_child True ptr_child_ptr_child_node by auto
      ultimately have "castnode_ptr2object_ptr ptr_child_node ∈ set ancestors"
        using 1 by auto
      moreover have "h ⊢ get_parent ptr_child_node →r Some ptr"
        using assms(1) children ptr_child_node child_parent_dual
        using ‹known_ptrs h› ‹type_wf h› by blast
      ultimately show ?thesis
        using get_ancestors_si_also_parent assms ‹type_wf h› by blast
    next
      case False
      then
      obtain host where host: "ptr = castelement_ptr2object_ptr host"
        using ptr_child
        by(auto simp add: a_host_shadow_root_rel_def)
      then obtain shadow_root where shadow_root: "h ⊢ get_shadow_root host →r Some shadow_root"
        and ptr_child_shadow_root: "ptr_child = cast shadow_root"
        using ptr_child False
        apply(auto simp add: a_host_shadow_root_rel_def)[1]
        by (metis (no_types, lifting) assms(3) local.get_shadow_root_ok select_result_I)

      moreover have "(cast shadow_root, child) ∈ (parent_child_rel h ∪ local.a_host_shadow_root_rel h)*"
        using ptr_child ptr_child_shadow_root by blast
      ultimately have "cast shadow_root ∈ set ancestors"
        using "1.hyps"(2) host by blast
      moreover have "h ⊢ get_host shadow_root →r host"
        by (metis assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_host_ok
            local.get_shadow_root_shadow_root_ptr_in_heap local.shadow_root_host_dual
            local.shadow_root_same_host shadow_root)
      ultimately show ?thesis
        using get_ancestors_si_also_host assms(1) assms(2) assms(3) assms(4) host
        by blast
    qed
  qed
qed

lemma get_root_node_si_ok:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
    and "ptr |∈| object_ptr_kinds h"
  shows "h ⊢ ok (get_root_node_si ptr)"
  using assms get_ancestors_si_ok
  by(auto simp add: get_root_node_si_def)

lemma get_root_node_si_root_in_heap:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ get_root_node_si ptr →r root"
  shows "root |∈| object_ptr_kinds h"
  using assms
  apply(auto simp add: get_root_node_si_def elim!: bind_returns_result_E2)[1]
  by (simp add: get_ancestors_si_never_empty get_ancestors_si_ptrs_in_heap)

lemma get_root_node_si_same_no_parent:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ get_root_node_si ptr →r cast child"
  shows "h ⊢ get_parent child →r None"
proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev_si)
  case (step c)
  then show ?case
  proof (cases "castobject_ptr2node_ptr c")
    case None
    then show ?thesis
      using step(3)
      by(auto simp add: get_root_node_si_def get_ancestors_si_def[of c]
          elim!: bind_returns_result_E2
          split: if_splits option.splits
          intro!: step(2) bind_pure_returns_result_I)
  next
    case (Some child_node)
    note s = this
    then obtain parent_opt where parent_opt: "h ⊢ get_parent child_node →r parent_opt"
      using step(3)
      apply(auto simp add: get_root_node_si_def get_ancestors_si_def
          intro!: bind_pure_I
          elim!: bind_returns_result_E2)[1]
      by(auto split: option.splits)
    then show ?thesis
    proof(induct parent_opt)
      case None
      then show ?case
        using Some get_root_node_si_no_parent returns_result_eq step.prems by fastforce
    next
      case (Some parent)
      then show ?case
        using step(3) s
        apply(auto simp add: get_root_node_si_def get_ancestors_si_def[of c]
            elim!: bind_returns_result_E2 split: option.splits list.splits if_splits)[1]
        using assms(1) get_ancestors_si_never_empty apply blast
        by(auto simp add: get_root_node_si_def
            dest: returns_result_eq
            intro!: step(1) bind_pure_returns_result_I)
    qed
  qed
qed
end

interpretation i_get_root_node_si_wf?: l_get_root_node_si_wfShadow_DOM type_wf known_ptr known_ptrs
  get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_host get_host_locs
  get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
  get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM
  get_disconnected_document get_disconnected_document_locs
  by(auto simp add: instances l_get_root_node_si_wfShadow_DOM_def)
declare l_get_root_node_si_wfShadow_DOM_axioms [instances]


subsubsection ‹get\_disconnected\_document›

locale l_get_disconnected_document_wfShadow_DOM =
  l_heap_is_wellformedShadow_DOM +
  l_get_disconnected_documentCore_DOM +
  l_get_parent_wf +
  l_get_parent
begin

lemma get_disconnected_document_ok:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ get_parent node_ptr →r None"
  shows "h ⊢ ok (get_disconnected_document node_ptr)"
proof -
  have "node_ptr |∈| node_ptr_kinds h"
    by (meson assms(4) is_OK_returns_result_I local.get_parent_ptr_in_heap)
  have "¬(∃parent ∈ fset (object_ptr_kinds h). node_ptr ∈ set |h ⊢ get_child_nodes parent|r)"
    apply(auto)[1]
    using assms(4) child_parent_dual[OF assms(1)]
      assms(1) assms(2) assms(3) known_ptrs_known_ptr option.simps(3)
      returns_result_eq returns_result_select_result
    by (metis (no_types, lifting) CD.get_child_nodes_ok)
  then
  have "(∃document_ptr ∈ fset (document_ptr_kinds h). node_ptr ∈
    set |h ⊢ get_disconnected_nodes document_ptr|r)"
    using heap_is_wellformed_children_disc_nodes
    using ‹node_ptr |∈| node_ptr_kinds h› assms(1) by blast
  then obtain some_owner_document where
    "some_owner_document ∈ set (sorted_list_of_set (fset (document_ptr_kinds h)))" and
    "node_ptr ∈ set |h ⊢ get_disconnected_nodes some_owner_document|r"
    by auto

  have h5: "∃!x. x ∈ set (sorted_list_of_set (fset (document_ptr_kinds h))) ∧
    h ⊢ Heap_Error_Monad.bind (get_disconnected_nodes x)
                  (λchildren. return (node_ptr ∈ set children)) →r True"
    apply(auto intro!: bind_pure_returns_result_I)[1]
     apply (smt (verit, best) CD.get_disconnected_nodes_ok CD.get_disconnected_nodes_pure
             ‹∃document_ptr∈fset (document_ptr_kinds h). node_ptr ∈ set |h ⊢ get_disconnected_nodes
             document_ptr|r› assms(2) bind_pure_returns_result_I return_returns_result
             returns_result_select_result)
    apply(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)[1]
    using heap_is_wellformed_one_disc_parent assms(1)
    by blast
  let ?filter_M = "filter_M
             (λdocument_ptr.
                 Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                  (λdisconnected_nodes. return (node_ptr ∈ set disconnected_nodes)))
             (sorted_list_of_set (fset (document_ptr_kinds h)))"
  have "h ⊢ ok (?filter_M)"
    using CD.get_disconnected_nodes_ok
    by (smt (verit) CD.get_disconnected_nodes_pure DocumentMonad.ptr_kinds_M_ptr_kinds
        DocumentMonad.ptr_kinds_ptr_kinds_M assms(2) bind_is_OK_pure_I bind_pure_I
        document_ptr_kinds_M_def filter_M_is_OK_I l_ptr_kinds_M.ptr_kinds_M_ok return_ok
        return_pure returns_result_select_result)
  then
  obtain candidates where candidates: "h ⊢ filter_M
             (λdocument_ptr.
                 Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                  (λdisconnected_nodes. return (node_ptr ∈ set disconnected_nodes)))
             (sorted_list_of_set (fset (document_ptr_kinds h)))
       →r candidates"
    by auto
  have "candidates = [some_owner_document]"
    apply(rule filter_M_ex1[OF candidates ‹some_owner_document ∈
               set (sorted_list_of_set (fset (document_ptr_kinds h)))› h5])
    using ‹node_ptr ∈ set |h ⊢ get_disconnected_nodes some_owner_document|r›
      ‹some_owner_document ∈ set (sorted_list_of_set (fset (document_ptr_kinds h)))›
    by(auto simp add: CD.get_disconnected_nodes_ok assms(2)
        intro!: bind_pure_I
        intro!: bind_pure_returns_result_I)
  then show ?thesis
    using candidates  ‹node_ptr |∈| node_ptr_kinds h›
    apply(auto simp add: get_disconnected_document_def
        intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I
        split: list.splits)[1]
     apply (meson not_Cons_self2 returns_result_eq)
    by (meson list.distinct(1) list.inject returns_result_eq)
qed
end

interpretation i_get_disconnected_document_wf?: l_get_disconnected_document_wfShadow_DOM
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_host get_host_locs
  get_disconnected_document get_disconnected_document_locs known_ptrs get_parent get_parent_locs
  by(auto simp add: l_get_disconnected_document_wfShadow_DOM_def instances)
declare l_get_disconnected_document_wfShadow_DOM_axioms [instances]


subsubsection ‹get\_owner\_document›

locale l_get_owner_document_wfShadow_DOM =
  l_get_disconnected_nodes +
  l_get_child_nodes +
  l_get_owner_documentShadow_DOM +
  l_heap_is_wellformedShadow_DOM +
  l_get_parent_wf +
  l_known_ptrs +
  l_get_root_node_si_wfShadow_DOM +
  l_get_parentCore_DOM +
  assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
begin
lemma get_owner_document_disconnected_nodes:
  assumes "heap_is_wellformed h"
  assumes "h ⊢ get_disconnected_nodes document_ptr →r disc_nodes"
  assumes "node_ptr ∈ set disc_nodes"
  assumes known_ptrs: "known_ptrs h"
  assumes type_wf: "type_wf h"
  shows "h ⊢ get_owner_document (cast node_ptr) →r document_ptr"
proof -
  have 2: "node_ptr |∈| node_ptr_kinds h"
    using assms
    apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.a_all_ptrs_in_heap_def)[1]
    using assms(1) local.heap_is_wellformed_disc_nodes_in_heap by blast
  have 3: "document_ptr |∈| document_ptr_kinds h"
    using assms(2) get_disconnected_nodes_ptr_in_heap by blast
  then have 4: "¬(∃parent_ptr. parent_ptr |∈| object_ptr_kinds h ∧
    node_ptr ∈ set |h ⊢ get_child_nodes parent_ptr|r)"
    using CD.distinct_lists_no_parent assms
    unfolding heap_is_wellformed_def CD.heap_is_wellformed_def by simp
  moreover have "(∃document_ptr. document_ptr |∈| document_ptr_kinds h ∧
        node_ptr ∈ set |h ⊢ get_disconnected_nodes document_ptr|r) ∨
       (∃parent_ptr. parent_ptr |∈| object_ptr_kinds h ∧
        node_ptr ∈ set |h ⊢ get_child_nodes parent_ptr|r)"
    using assms(1) 2 "3" assms(2) assms(3) by auto
  ultimately have 0: "∃!document_ptr∈set |h ⊢ document_ptr_kinds_M|r.
    node_ptr ∈ set |h ⊢ get_disconnected_nodes document_ptr|r"
    by (meson DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) disjoint_iff
        local.get_disconnected_nodes_ok local.heap_is_wellformed_one_disc_parent
        returns_result_select_result type_wf)

  have "h ⊢ get_parent node_ptr →r None"
    by (metis (mono_tags, lifting) "2" "4" known_ptrs local.get_parent_child_dual
        local.get_parent_ok local.get_parent_parent_in_heap returns_result_select_result
        select_result_I2 split_option_ex type_wf)

  then have 4: "h ⊢ get_root_node_si (cast node_ptr) →r cast node_ptr"
    using get_root_node_si_no_parent
    by simp
  obtain document_ptrs where document_ptrs: "h ⊢ document_ptr_kinds_M →r document_ptrs"
    by simp
  then have "h ⊢ ok (filter_M (λdocument_ptr. do {
          disconnected_nodes ← get_disconnected_nodes document_ptr;
          return (((castnode_ptr2object_ptr node_ptr)) ∈ cast ` set disconnected_nodes)
        }) document_ptrs)"
    using assms(1) get_disconnected_nodes_ok type_wf
    by(auto intro!: bind_is_OK_I2 filter_M_is_OK_I bind_pure_I)
  then obtain candidates where
    candidates: "h ⊢ filter_M (λdocument_ptr. do {
          disconnected_nodes ← get_disconnected_nodes document_ptr;
          return (((castnode_ptr2object_ptr node_ptr)) ∈ cast ` set disconnected_nodes)
        }) document_ptrs →r candidates"
    by auto

  have filter: "filter (λdocument_ptr. |h ⊢ do {
          disconnected_nodes ← get_disconnected_nodes document_ptr;
          return (castnode_ptr2object_ptr node_ptr ∈ cast ` set disconnected_nodes)
        }|r) document_ptrs = [document_ptr]"
    apply(rule filter_ex1)
    using 0 document_ptrs
       apply (smt (verit) DocumentMonad.ptr_kinds_ptr_kinds_M bind_pure_returns_result_I2
               local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure node_ptr_inclusion
               return_returns_result select_result_I2 type_wf)
    using assms(2) assms(3)
      apply (metis (no_types, lifting) bind_pure_returns_result_I2 is_OK_returns_result_I
        local.get_disconnected_nodes_pure node_ptr_inclusion return_returns_result select_result_I2)
    using document_ptrs  3 apply(simp)
    using document_ptrs
    by simp
  have "h ⊢ filter_M (λdocument_ptr. do {
          disconnected_nodes ← get_disconnected_nodes document_ptr;
          return (((castnode_ptr2object_ptr node_ptr)) ∈ cast ` set disconnected_nodes)
        }) document_ptrs →r [document_ptr]"
    apply(rule filter_M_filter2)
    using get_disconnected_nodes_ok document_ptrs 3  assms(1)  type_wf filter
    by(auto intro: bind_pure_I bind_is_OK_I2)

  with 4 document_ptrs have "h ⊢ CD.a_get_owner_documentnode_ptr node_ptr () →r document_ptr"
    by(auto simp add: CD.a_get_owner_documentnode_ptr_def
        intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)
  moreover have "known_ptr (cast node_ptr)"
    using known_ptrs_known_ptr[OF known_ptrs, where ptr="castnode_ptr2object_ptr node_ptr"] 2
      known_ptrs_implies
    by(simp)
  ultimately show ?thesis
    using 2
    apply(auto simp add: CD.a_get_owner_document_tups_def get_owner_document_def
        a_get_owner_document_tups_def known_ptr_impl)[1]
    apply(split invoke_splits, (rule conjI | rule impI)+)+
        apply(drule(1) known_ptr_not_shadow_root_ptr)
        apply(drule(1) known_ptr_not_document_ptr)
        apply(drule(1)  known_ptr_not_character_data_ptr)
        apply(drule(1)  known_ptr_not_element_ptr)
        apply(simp add: NodeClass.known_ptr_defs)
    by(auto split: option.splits intro!: bind_pure_returns_result_I)
qed

lemma in_disconnected_nodes_no_parent:
  assumes "heap_is_wellformed h"
  assumes "h ⊢ get_parent node_ptr →r None"
  assumes "h ⊢ get_owner_document (cast node_ptr) →r owner_document"
  assumes "h ⊢ get_disconnected_nodes owner_document →r disc_nodes"
  assumes "known_ptrs h"
  assumes "type_wf h"
  shows "node_ptr ∈ set disc_nodes"
proof -
  have "⋀parent. parent |∈| object_ptr_kinds h ⟹ node_ptr ∉ set |h ⊢ get_child_nodes parent|r"
    using assms(2)
    by (meson get_child_nodes_ok assms(1) assms(5) assms(6) local.child_parent_dual
        local.known_ptrs_known_ptr option.distinct(1) returns_result_eq returns_result_select_result)
  then show ?thesis
    by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
        is_OK_returns_result_I local.get_disconnected_nodes_ok
        local.get_owner_document_disconnected_nodes local.get_parent_ptr_in_heap
        local.heap_is_wellformed_children_disc_nodes returns_result_eq returns_result_select_result)
qed


lemma get_owner_document_owner_document_in_heap_node:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ CD.a_get_owner_documentnode_ptr node_ptr () →r owner_document"
  shows "owner_document |∈| document_ptr_kinds h"
proof -
  obtain root where
    root: "h ⊢ get_root_node_si (cast node_ptr) →r root"
    using assms(4)
    by(auto simp add: CD.a_get_owner_documentnode_ptr_def
        elim!: bind_returns_result_E2
        split: option.splits)

  then show ?thesis
  proof (cases "is_document_ptr root")
    case True
    then show ?thesis
      using assms(4) root
      apply(auto simp add: CD.a_get_owner_documentnode_ptr_def elim!:  bind_returns_result_E2
          intro!: filter_M_pure_I bind_pure_I split: option.splits)[1]
       apply(drule(1) returns_result_eq) apply(auto)[1]
      using assms document_ptr_kinds_commutes get_root_node_si_root_in_heap
      by blast
  next
    case False
    have "known_ptr root"
      using assms local.get_root_node_si_root_in_heap local.known_ptrs_known_ptr root by blast
    have "root |∈| object_ptr_kinds h"
      using root
      using assms local.get_root_node_si_root_in_heap
      by blast

    have "¬is_shadow_root_ptr root"
      using root
      using local.get_root_node_si_root_not_shadow_root by blast
    then have "is_node_ptr_kind root"
      using False ‹known_ptr root› ‹root |∈| object_ptr_kinds h›
      apply(simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
          CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs)
      using is_node_ptr_kind_none by force
    then
    have "(∃document_ptr ∈ fset (document_ptr_kinds h).
root ∈ cast ` set |h ⊢ get_disconnected_nodes document_ptr|r)"
      using local.child_parent_dual local.get_child_nodes_ok local.get_root_node_si_same_no_parent
        local.heap_is_wellformed_children_disc_nodes local.known_ptrs_known_ptr node_ptr_casts_commute3
        node_ptr_inclusion node_ptr_kinds_commutes option.distinct(1) returns_result_eq
        returns_result_select_result root
      by (metis (no_types, opaque_lifting) assms ‹root |∈| object_ptr_kinds h›)
    then obtain some_owner_document where
      "some_owner_document |∈| document_ptr_kinds h" and
      "root ∈ cast ` set |h ⊢ get_disconnected_nodes some_owner_document|r"
      by auto
    then
    obtain candidates where
      candidates: "h ⊢ filter_M
             (λdocument_ptr.
                 Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                  (λdisconnected_nodes. return (root ∈ castnode_ptr2object_ptr ` set disconnected_nodes)))
             (sorted_list_of_set (fset (document_ptr_kinds h)))
       →r candidates"
      by (metis (no_types, lifting) assms bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
          is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure
          return_ok return_pure sorted_list_of_set(1))
    then have "some_owner_document ∈ set candidates"
      apply(rule filter_M_in_result_if_ok)
      using ‹some_owner_document |∈| document_ptr_kinds h›
        ‹root ∈ cast ` set |h ⊢ get_disconnected_nodes some_owner_document|r›
        apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
      using ‹some_owner_document |∈| document_ptr_kinds h›
        ‹root ∈ cast ` set |h ⊢ get_disconnected_nodes some_owner_document|r›
       apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
      using ‹some_owner_document |∈| document_ptr_kinds h›
        ‹root ∈ cast ` set |h ⊢ get_disconnected_nodes some_owner_document|r›
      apply(auto simp add: assms local.get_disconnected_nodes_ok
          intro!: bind_pure_I bind_pure_returns_result_I)[1]
      done
    then have "candidates ≠ []"
      by auto
    then have "owner_document ∈ set candidates"
      using assms(4) root
      apply(auto simp add: CD.a_get_owner_documentnode_ptr_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 ‹is_node_ptr_kind root› node_ptr_no_document_ptr_cast returns_result_eq)

    then show ?thesis
      using candidates
      by (meson bind_pure_I bind_returns_result_E2 filter_M_holds_for_result is_OK_returns_result_I
          local.get_disconnected_nodes_ptr_in_heap local.get_disconnected_nodes_pure return_pure)
  qed
qed

lemma get_owner_document_owner_document_in_heap:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ get_owner_document ptr →r owner_document"
  shows "owner_document |∈| document_ptr_kinds h"
  using assms
  apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def
      CD.a_get_owner_document_tups_def)[1]
  apply(split invoke_split_asm)+
proof -
  assume "h ⊢ invoke [] ptr () →r owner_document"
  then show "owner_document |∈| document_ptr_kinds h"
    by (meson invoke_empty is_OK_returns_result_I)
next
  assume "h ⊢ Heap_Error_Monad.bind (check_in_heap ptr)
          (λ_. (CD.a_get_owner_documentdocument_ptr ∘ the ∘ castobject_ptr2document_ptr) ptr ())
    →r owner_document"
  then show "owner_document |∈| document_ptr_kinds h"
    by(auto simp add: CD.a_get_owner_documentdocument_ptr_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: "¬ is_element_ptrobject_ptr ptr"
    and 4: "is_character_data_ptrobject_ptr ptr"
    and 5: "h ⊢ Heap_Error_Monad.bind (check_in_heap ptr)
          (λ_. (CD.a_get_owner_documentnode_ptr ∘ the ∘ castobject_ptr2node_ptr) ptr ()) →r owner_document"
  then show ?thesis
    by (metis bind_returns_result_E2 check_in_heap_pure comp_apply
        get_owner_document_owner_document_in_heap_node)
next
  assume 0: "heap_is_wellformed h"
    and 1: "type_wf h"
    and 2: "known_ptrs h"
    and 3: "is_element_ptrobject_ptr ptr"
    and 4: "h ⊢ Heap_Error_Monad.bind (check_in_heap ptr)
          (λ_. (CD.a_get_owner_documentnode_ptr ∘ the ∘ castobject_ptr2node_ptr) ptr ()) →r owner_document"
  then show ?thesis
    by (metis bind_returns_result_E2 check_in_heap_pure comp_apply
        get_owner_document_owner_document_in_heap_node)
next
  assume 0: "heap_is_wellformed h"
    and 1: "type_wf h"
    and 2: "known_ptrs h"
    and 3: "¬ is_element_ptrobject_ptr ptr"
    and 4: "¬ is_character_data_ptrobject_ptr ptr"
    and 5: "¬ is_document_ptrobject_ptr ptr"
    and 6: "is_shadow_root_ptrobject_ptr ptr"
    and 7: "h ⊢ Heap_Error_Monad.bind (check_in_heap ptr)
            (λ_. (local.a_get_owner_documentshadow_root_ptr ∘ the ∘ castobject_ptr2shadow_root_ptr) ptr ())
             →r owner_document"
  then show "owner_document |∈| document_ptr_kinds h"
    apply(auto simp add: CD.a_get_owner_documentdocument_ptr_def a_get_owner_documentshadow_root_ptr_def
        intro!: filter_M_pure_I bind_pure_I
        elim!: bind_returns_result_E2
        split: if_splits option.splits)[1]
    using get_owner_document_owner_document_in_heap_node by blast
qed

lemma get_owner_document_ok:
  assumes "heap_is_wellformed h"  "known_ptrs h" "type_wf h"
  assumes "ptr |∈| object_ptr_kinds h"
  shows "h ⊢ ok (get_owner_document ptr)"
proof -
  have "known_ptr ptr"
    using assms(2) assms(4) local.known_ptrs_known_ptr
    by blast
  then show ?thesis
    apply(simp add: get_owner_document_def a_get_owner_document_tups_def CD.a_get_owner_document_tups_def)
    apply(split invoke_splits, (rule conjI | rule impI)+)+
  proof -
    assume 0: "known_ptr ptr"
      and 1: "¬ is_element_ptrobject_ptr ptr"
      and 2: "¬ is_character_data_ptrobject_ptr ptr"
      and 3: "¬ is_document_ptrobject_ptr ptr"
      and 4: "¬ is_shadow_root_ptrobject_ptr ptr"
    then show "h ⊢ ok invoke [] ptr ()"
      using NodeClass.a_known_ptr_def known_ptr_not_character_data_ptr known_ptr_not_document_ptr
        known_ptr_not_shadow_root_ptr known_ptr_not_element_ptr known_ptr_impl
      by blast
  next
    assume 0: "known_ptr ptr"
      and 1: "¬ is_element_ptrobject_ptr ptr"
      and 2: "¬ is_character_data_ptrobject_ptr ptr"
      and 3: "¬ is_document_ptrobject_ptr ptr"
    then show "is_shadow_root_ptrobject_ptr ptr ⟶ h ⊢ ok Heap_Error_Monad.bind (check_in_heap ptr)
    (λ_. (local.a_get_owner_documentshadow_root_ptr ∘ the ∘ castobject_ptr2shadow_root_ptr) ptr ())"
      using assms(1) assms(2) assms(3) assms(4)
      by(auto simp add: local.get_host_ok get_root_node_def
          CD.a_get_owner_documentdocument_ptr_def CD.a_get_owner_documentnode_ptr_def
          a_get_owner_documentshadow_root_ptr_def
          intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
          get_disconnected_nodes_ok
          intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual
          split: option.splits)
  next
    show "is_document_ptrobject_ptr ptr ⟶ h ⊢ ok Heap_Error_Monad.bind (check_in_heap ptr)
    (λ_. (local.CD.a_get_owner_documentdocument_ptr ∘ the ∘ castobject_ptr2document_ptr) ptr ())"
      using assms(4)
      by(auto simp add: CD.a_get_owner_documentdocument_ptr_def split: option.splits)
  next
    show "is_character_data_ptrobject_ptr ptr ⟶ h ⊢ ok Heap_Error_Monad.bind (check_in_heap ptr)
    (λ_. (local.CD.a_get_owner_documentnode_ptr ∘ the ∘ castobject_ptr2node_ptr) ptr ())"
      using assms(1) assms(2) assms(3) assms(4)
      by(auto simp add: local.get_host_ok get_root_node_def
          CD.a_get_owner_documentdocument_ptr_def CD.a_get_owner_documentnode_ptr_def
          a_get_owner_documentshadow_root_ptr_def
          intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
          get_disconnected_nodes_ok
          intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual split: option.splits)
  next
    show "is_element_ptrobject_ptr ptr ⟶ h ⊢ ok Heap_Error_Monad.bind (check_in_heap ptr)
    (λ_. (local.CD.a_get_owner_documentnode_ptr ∘ the ∘ castobject_ptr2node_ptr) ptr ())"
      using assms(1) assms(2) assms(3) assms(4)
      by(auto simp add: local.get_host_ok get_root_node_def
          CD.a_get_owner_documentdocument_ptr_def CD.a_get_owner_documentnode_ptr_def
          a_get_owner_documentshadow_root_ptr_def
          intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
          get_disconnected_nodes_ok
          intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual
          split: option.splits)
  qed
qed
end
interpretation i_get_owner_document_wf?: l_get_owner_document_wfShadow_DOM
  type_wf get_disconnected_nodes get_disconnected_nodes_locs known_ptr
  get_child_nodes get_child_nodes_locs DocumentClass.known_ptr get_parent get_parent_locs
  get_root_node_si get_root_node_si_locs CD.a_get_owner_document get_host get_host_locs
  get_owner_document get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
  heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_disconnected_document
  get_disconnected_document_locs known_ptrs get_ancestors_si get_ancestors_si_locs
  by(auto simp add: l_get_owner_document_wfShadow_DOM_def l_get_owner_document_wfShadow_DOM_axioms_def
      instances)
declare l_get_owner_document_wfShadow_DOM_axioms [instances]


lemma get_owner_document_wf_is_l_get_owner_document_wf [instances]: "l_get_owner_document_wf
  heap_is_wellformed type_wf known_ptr known_ptrs get_disconnected_nodes get_owner_document
  get_parent"
  apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def instances)[1]
  using get_owner_document_disconnected_nodes apply fast
  using in_disconnected_nodes_no_parent apply fast
  using get_owner_document_owner_document_in_heap apply fast
  using get_owner_document_ok apply fast
  done


subsubsection ‹remove\_child›

locale l_remove_child_wf2Shadow_DOM =
  l_set_disconnected_nodes_get_disconnected_nodes +
  l_get_child_nodes +
  l_heap_is_wellformedShadow_DOM +
  l_get_owner_document_wfShadow_DOM +
  l_remove_childCore_DOM +
  l_set_child_nodes_get_shadow_root +
  l_set_disconnected_nodes_get_shadow_root +
  l_set_child_nodes_get_tag_name +
  l_set_disconnected_nodes_get_tag_name +
  CD: l_remove_child_wf2Core_DOM _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ heap_is_wellformedCore_DOM
begin
lemma remove_child_preserves_type_wf:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove_child ptr child →h h'"
  shows "type_wf h'"
  using CD.remove_child_heap_is_wellformed_preserved(1) assms
  unfolding heap_is_wellformed_def
  by auto

lemma remove_child_preserves_known_ptrs:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove_child ptr child →h h'"
  shows "known_ptrs h'"
  using CD.remove_child_heap_is_wellformed_preserved(2) assms
  unfolding heap_is_wellformed_def
  by auto


lemma remove_child_heap_is_wellformed_preserved:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove_child ptr child →h h'"
  shows "heap_is_wellformed h'"
proof -
  have "heap_is_wellformedCore_DOM h'"
    using CD.remove_child_heap_is_wellformed_preserved(3) assms
    unfolding heap_is_wellformed_def
    by auto

  have shadow_root_eq: "⋀ptr' shadow_root_ptr_opt. h ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt =
    h' ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt"
    using get_shadow_root_reads remove_child_writes assms(4)
    apply(rule reads_writes_preserved)
    by(auto simp add: remove_child_locs_def set_child_nodes_get_shadow_root
        set_disconnected_nodes_get_shadow_root)
  then
  have shadow_root_eq2: "⋀ptr'. |h ⊢ get_shadow_root ptr'|r = |h' ⊢ get_shadow_root ptr'|r"
    by (meson select_result_eq)

  have tag_name_eq: "⋀ptr' tag. h ⊢ get_tag_name ptr' →r tag = h' ⊢ get_tag_name ptr' →r tag"
    using get_tag_name_reads remove_child_writes assms(4)
    apply(rule reads_writes_preserved)
    by(auto simp add: remove_child_locs_def set_child_nodes_get_tag_name
        set_disconnected_nodes_get_tag_name)
  then
  have tag_name_eq2: "⋀ptr'. |h ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
    by (meson select_result_eq)

  have object_ptr_kinds_eq: "object_ptr_kinds h = object_ptr_kinds h'"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
          OF remove_child_writes assms(4)])
    unfolding remove_child_locs_def
    using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
    by (auto simp add: reflp_def transp_def)

  have shadow_root_ptr_kinds_eq: "shadow_root_ptr_kinds h = shadow_root_ptr_kinds h'"
    using object_ptr_kinds_eq
    by(auto simp add: shadow_root_ptr_kinds_def)
  have element_ptr_kinds_eq: "element_ptr_kinds h = element_ptr_kinds h'"
    using object_ptr_kinds_eq
    by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)

  have "parent_child_rel h' ⊆ parent_child_rel h"
    using ‹heap_is_wellformed h› heap_is_wellformed_def
    using CD.remove_child_parent_child_rel_subset
    using ‹known_ptrs h› ‹type_wf h› assms(4)
    by simp

  show ?thesis
    using ‹heap_is_wellformed h›
    using ‹heap_is_wellformedCore_DOM h'› ‹parent_child_rel h' ⊆ parent_child_rel h›
    apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
        a_host_shadow_root_rel_def a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def
        object_ptr_kinds_eq element_ptr_kinds_eq shadow_root_ptr_kinds_eq  shadow_root_eq shadow_root_eq2
        tag_name_eq tag_name_eq2)[1]
    by (meson acyclic_subset order_refl sup_mono)
qed

lemma remove_preserves_type_wf:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove child →h h'"
  shows "type_wf h'"
  using CD.remove_heap_is_wellformed_preserved(1) assms
  unfolding heap_is_wellformed_def
  by auto

lemma remove_preserves_known_ptrs:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove child →h h'"
  shows "known_ptrs h'"
  using CD.remove_heap_is_wellformed_preserved(2) assms
  unfolding heap_is_wellformed_def
  by auto


lemma remove_heap_is_wellformed_preserved:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ remove child →h h'"
  shows "heap_is_wellformed h'"
  using assms
  by(auto simp add: remove_def elim!: bind_returns_heap_E2
      intro: remove_child_heap_is_wellformed_preserved
      split: option.splits)

lemma remove_child_removes_child:
  "heap_is_wellformed h ⟹ h ⊢ remove_child ptr' child →h h'
    ⟹ h' ⊢ get_child_nodes ptr →r children
    ⟹ known_ptrs h ⟹ type_wf h
    ⟹ child ∉ set children"
  using CD.remove_child_removes_child local.heap_is_wellformed_def by blast
lemma remove_child_removes_first_child: "heap_is_wellformed h ⟹ type_wf h ⟹ known_ptrs h ⟹
    h ⊢ get_child_nodes ptr →r node_ptr # children ⟹ h ⊢ remove_child ptr node_ptr →h h' ⟹
    h' ⊢ get_child_nodes ptr →r children"
  using CD.remove_child_removes_first_child local.heap_is_wellformed_def by blast
lemma remove_removes_child: "heap_is_wellformed h ⟹ type_wf h ⟹ known_ptrs h ⟹
    h ⊢ get_child_nodes ptr →r node_ptr # children ⟹ h ⊢ remove node_ptr →h h' ⟹
    h' ⊢ get_child_nodes ptr →r children"
  using CD.remove_removes_child local.heap_is_wellformed_def by blast
lemma remove_for_all_empty_children: "heap_is_wellformed h ⟹ type_wf h ⟹ known_ptrs h ⟹
    h ⊢ get_child_nodes ptr →r children ⟹ h ⊢ forall_M remove children →h h' ⟹
    h' ⊢ get_child_nodes ptr →r []"
  using CD.remove_for_all_empty_children local.heap_is_wellformed_def by blast
end

interpretation i_remove_child_wf2?: l_remove_child_wf2Shadow_DOM
  type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
  set_disconnected_nodes_locs known_ptr get_child_nodes get_child_nodes_locs get_shadow_root
  get_shadow_root_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs DocumentClass.known_ptr get_parent get_parent_locs get_root_node_si
  get_root_node_si_locs CD.a_get_owner_document get_owner_document known_ptrs get_ancestors_si
  get_ancestors_si_locs set_child_nodes set_child_nodes_locs remove_child remove_child_locs remove
  by(auto simp add: l_remove_child_wf2Shadow_DOM_def instances)
declare l_remove_child_wf2Shadow_DOM_axioms [instances]

lemma remove_child_wf2_is_l_remove_child_wf2 [instances]:
  "l_remove_child_wf2 type_wf known_ptr known_ptrs remove_child heap_is_wellformed get_child_nodes remove"
  apply(auto simp add: l_remove_child_wf2_def l_remove_child_wf2_axioms_def instances)[1]
  using remove_child_preserves_type_wf apply fast
  using remove_child_preserves_known_ptrs apply fast
  using remove_child_heap_is_wellformed_preserved apply (fast)
  using remove_preserves_type_wf apply fast
  using remove_preserves_known_ptrs apply fast
  using remove_heap_is_wellformed_preserved apply (fast)
  using remove_child_removes_child apply fast
  using remove_child_removes_first_child apply fast
  using remove_removes_child apply fast
  using remove_for_all_empty_children apply fast
  done



subsubsection ‹adopt\_node›

locale l_adopt_node_wf2Shadow_DOM =
  l_get_child_nodes +
  l_get_disconnected_nodes +
  l_set_child_nodes_get_shadow_root +
  l_set_disconnected_nodes_get_shadow_root +
  l_set_child_nodes_get_tag_name +
  l_set_disconnected_nodes_get_tag_name +
  l_heap_is_wellformedShadow_DOM +
  l_get_root_node +
  l_set_disconnected_nodes_get_child_nodes +
  l_get_owner_document_wf +
  l_remove_child_wf2 +
  l_adopt_node_wfCore_DOM +
  l_adopt_nodeCore_DOM +
  l_get_parent_wfCore_DOM
begin

lemma adopt_node_removes_child:
  assumes wellformed: "heap_is_wellformed h"
    and adopt_node: "h ⊢ adopt_node owner_document node_ptr →h h2"
    and children: "h2 ⊢ get_child_nodes ptr →r children"
    and known_ptrs: "known_ptrs h"
    and type_wf: "type_wf h"
  shows "node_ptr ∉ set children"
proof -
  obtain old_document parent_opt h' where
    old_document: "h ⊢ get_owner_document (cast node_ptr) →r old_document" and
    parent_opt: "h ⊢ get_parent node_ptr →r parent_opt" and
    h': "h ⊢ (case parent_opt of Some parent ⇒ remove_child parent node_ptr | None ⇒ return () ) →h h'"
    using adopt_node
    by(auto simp add: adopt_node_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated,
          OF get_owner_document_pure, rotated] bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] split: if_splits)

  then have "h' ⊢ get_child_nodes ptr →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
        ‹h' ⊢ get_child_nodes ptr →r children› returns_result_eq by fastforce
  next
    case (Some option)
    then show ?case
      using remove_child_removes_child ‹h' ⊢ get_child_nodes ptr →r children› known_ptrs type_wf
        wellformed
      by auto
  qed
qed

lemma adopt_node_preserves_wellformedness:
  assumes "heap_is_wellformed h"
    and "h ⊢ adopt_node document_ptr child →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 ⊢ get_owner_document (cast child) →r old_document" and
    parent_opt: "h ⊢ get_parent child →r parent_opt" and
    h2: "h ⊢ (case parent_opt of Some parent ⇒ remove_child parent child | None ⇒ return ()) →h h2" and
    h': "h2 ⊢ (if document_ptr ≠ old_document then do {
        old_disc_nodes ← get_disconnected_nodes old_document;
        set_disconnected_nodes old_document (remove1 child old_disc_nodes);
        disc_nodes ← get_disconnected_nodes document_ptr;
        set_disconnected_nodes document_ptr (child # disc_nodes)
      } else do {
        return ()
      }) →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="λ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:
    "⋀ptrs. h ⊢ object_ptr_kinds_M →r ptrs = h2 ⊢ object_ptr_kinds_M →r ptrs"
    unfolding object_ptr_kinds_M_defs by simp
  then have object_ptr_kinds_eq_h: "|h ⊢ object_ptr_kinds_M|r = |h2 ⊢ object_ptr_kinds_M|r"
    by simp
  then have node_ptr_kinds_eq_h: "|h ⊢ node_ptr_kinds_M|r = |h2 ⊢ node_ptr_kinds_M|r"
    using node_ptr_kinds_M_eq by blast

  have wellformed_h2: "heap_is_wellformed h2"
    using h2 remove_child_heap_is_wellformed_preserved known_ptrs type_wf
    by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
  have "type_wf h2"
    using h2 remove_child_preserves_type_wf assms
    by(auto split: option.splits)
  have "known_ptrs h2"
    using h2 remove_child_preserves_known_ptrs assms
    by(auto split: option.splits)

  then have "heap_is_wellformed h' ∧ known_ptrs h' ∧ type_wf h'"
  proof(cases "document_ptr = old_document")
    case True
    then show "heap_is_wellformed h' ∧ known_ptrs h' ∧ type_wf h'"
      using h' wellformed_h2 ‹known_ptrs h2› ‹type_wf h2› by auto
  next
    case False
    then obtain h3 old_disc_nodes disc_nodes_document_ptr_h3 where
      docs_neq: "document_ptr ≠ old_document" and
      old_disc_nodes: "h2 ⊢ get_disconnected_nodes old_document →r old_disc_nodes" and
      h3: "h2 ⊢ set_disconnected_nodes old_document (remove1 child old_disc_nodes) →h h3" and
      disc_nodes_document_ptr_h3: "h3 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_document_ptr_h3" and
      h': "h3 ⊢ set_disconnected_nodes document_ptr (child # disc_nodes_document_ptr_h3) →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="λ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:
      "⋀ptrs. h2 ⊢ object_ptr_kinds_M →r ptrs = h3 ⊢ object_ptr_kinds_M →r ptrs"
      by(simp add: object_ptr_kinds_M_defs)
    then have object_ptr_kinds_eq_h2: "|h2 ⊢ object_ptr_kinds_M|r = |h3 ⊢ object_ptr_kinds_M|r"
      by(simp)
    then have node_ptr_kinds_eq_h2: "|h2 ⊢ node_ptr_kinds_M|r = |h3 ⊢ node_ptr_kinds_M|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 ⊢ document_ptr_kinds_M|r = |h3 ⊢ document_ptr_kinds_M|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:
      "⋀ptr children. h2 ⊢ get_child_nodes ptr →r children = h3 ⊢ get_child_nodes ptr →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: "⋀ptr. |h2 ⊢ get_child_nodes ptr|r = |h3 ⊢ get_child_nodes ptr|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="λ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:
      "⋀ptrs. h3 ⊢ object_ptr_kinds_M →r ptrs = h' ⊢ object_ptr_kinds_M →r ptrs"
      by(simp add: object_ptr_kinds_M_defs)
    then have object_ptr_kinds_eq_h3: "|h3 ⊢ object_ptr_kinds_M|r = |h' ⊢ object_ptr_kinds_M|r"
      by(simp)
    then have node_ptr_kinds_eq_h3: "|h3 ⊢ node_ptr_kinds_M|r = |h' ⊢ node_ptr_kinds_M|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 ⊢ document_ptr_kinds_M|r = |h' ⊢ document_ptr_kinds_M|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:
      "⋀ptr children. h3 ⊢ get_child_nodes ptr →r children = h' ⊢ get_child_nodes ptr →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: "⋀ptr. |h3 ⊢ get_child_nodes ptr|r = |h' ⊢ get_child_nodes ptr|r"
      using select_result_eq by force

    have disconnected_nodes_eq_h2: "⋀doc_ptr disc_nodes. old_document ≠ doc_ptr ⟹
      h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h3 ⊢ get_disconnected_nodes doc_ptr →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: "⋀doc_ptr. old_document ≠ doc_ptr ⟹
      |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h3 ⊢ get_disconnected_nodes doc_ptr|r"
      using select_result_eq by force
    obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2:
      "h2 ⊢ get_disconnected_nodes old_document →r disc_nodes_old_document_h2"
      using old_disc_nodes by blast
    then have disc_nodes_old_document_h3:
      "h3 ⊢ get_disconnected_nodes old_document →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="λh h'. type_wf h ⟶ 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="λh h'. type_wf h ⟶ 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="λh h'. type_wf h ⟶ type_wf h'",
          OF set_disconnected_nodes_writes h']
      using  set_disconnected_nodes_types_preserved
      by(auto simp add: reflp_def transp_def)

    have disconnected_nodes_eq_h3: "⋀doc_ptr disc_nodes. document_ptr ≠ doc_ptr ⟹
      h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h' ⊢ get_disconnected_nodes doc_ptr →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: "⋀doc_ptr. document_ptr ≠ doc_ptr ⟹
      |h3 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
      using select_result_eq by force
    have disc_nodes_document_ptr_h2:
      "h2 ⊢ get_disconnected_nodes document_ptr →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' ⊢ get_disconnected_nodes document_ptr →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 |∈| 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 |∈| 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 ∈ set disc_nodes_old_document_h2"
    proof (insert parent_opt h2, induct parent_opt)
      case None
      then have "h = h2"
        by(auto)
      moreover have "CD.a_owner_document_valid h"
        using assms(1)  by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
      ultimately show ?case
        using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)]
          in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast
    next
      case (Some option)
      then show ?case
        apply(simp split: option.splits)
        using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes
          known_ptrs by blast
    qed
    have "child ∉ set (remove1 child disc_nodes_old_document_h2)"
      using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2
        ‹distinct disc_nodes_old_document_h2› by auto
    have "child ∉ set disc_nodes_document_ptr_h3"
    proof -
      have "CD.a_distinct_lists h2"
        using heap_is_wellformed_def CD.heap_is_wellformed_def wellformed_h2 by blast
      then have 0: "distinct (concat (map (λdocument_ptr.
        |h2 ⊢ get_disconnected_nodes document_ptr|r) |h2 ⊢ document_ptr_kinds_M|r))"
        by(simp add: CD.a_distinct_lists_def)
      show ?thesis
        using distinct_concat_map_E(1)[OF 0] ‹child ∈ set disc_nodes_old_document_h2›
          disc_nodes_old_document_h2 disc_nodes_document_ptr_h2
        by (meson ‹type_wf h2› 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 |∈| node_ptr_kinds h"
      using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]]
        node_ptr_kinds_commutes by blast
    have "CD.a_acyclic_heap h2"
      using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
    have "parent_child_rel h' ⊆ parent_child_rel h2"
    proof
      fix x
      assume "x ∈ parent_child_rel h'"
      then show "x ∈ parent_child_rel h2"
        using object_ptr_kinds_h2_eq3  object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3
          mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong
        unfolding CD.parent_child_rel_def
        by(simp)
    qed
    then have " CD.a_acyclic_heap h'"
      using ‹ CD.a_acyclic_heap h2›  CD.acyclic_heap_def acyclic_subset by blast

    moreover have " CD.a_all_ptrs_in_heap h2"
      using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
    then have "CD.a_all_ptrs_in_heap h3"
      apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1]
       apply (metis ‹type_wf h'› children_eq2_h3 children_eq_h2 children_eq_h3 known_ptrs
          l_heap_is_wellformed.heap_is_wellformed_children_in_heap local.get_child_nodes_ok
          local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms node_ptr_kinds_eq3_h2
          object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3
          returns_result_select_result wellformed_h2)
      by (metis (no_types, opaque_lifting) disc_nodes_old_document_h2 disc_nodes_old_document_h3
          disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2 select_result_I2
          set_remove1_subset subsetD)
    then have "CD.a_all_ptrs_in_heap h'"
      apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1]
       apply (metis (no_types, opaque_lifting) children_eq2_h3 object_ptr_kinds_h3_eq3 subsetD)
      by (metis (no_types, opaque_lifting) ‹child ∈ set disc_nodes_old_document_h2› disc_nodes_document_ptr_h'
          disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disconnected_nodes_eq2_h3
          document_ptr_kinds_eq3_h3 local.heap_is_wellformed_disc_nodes_in_heap
          node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 select_result_I2 set_ConsD subsetD wellformed_h2)

    moreover have "CD.a_owner_document_valid h2"
      using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
    then have "CD.a_owner_document_valid h'"
      apply(simp add: CD.a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3
          object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3
          children_eq2_h2 children_eq2_h3 )
      by (metis (no_types) disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2
          disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2
          disconnected_nodes_eq2_h3 document_ptr_in_heap document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3
          in_set_remove1 list.set_intros(1) list.set_intros(2) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
          object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2)

    have a_distinct_lists_h2: "CD.a_distinct_lists h2"
      using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
    then have "CD.a_distinct_lists h'"
      apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2
          children_eq2_h2 children_eq2_h3)[1]
    proof -
      assume 1: "distinct (concat (map (λptr. |h' ⊢ get_child_nodes ptr|r)
        (sorted_list_of_set (fset (object_ptr_kinds h')))))"
        and 2: "distinct (concat (map (λdocument_ptr. |h2 ⊢ get_disconnected_nodes document_ptr|r)
        (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
        and 3: "(⋃x∈fset (object_ptr_kinds h'). set |h' ⊢ get_child_nodes x|r) ∩
        (⋃x∈fset (document_ptr_kinds h2). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
      show "distinct (concat (map (λdocument_ptr. |h' ⊢ get_disconnected_nodes document_ptr|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 ∈ set (sorted_list_of_set (fset (document_ptr_kinds h')))"
        have 4: "distinct |h2 ⊢ get_disconnected_nodes x|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' ⊢ get_disconnected_nodes x|r"
        proof (cases "old_document ≠ x")
          case True
          then show ?thesis
          proof (cases "document_ptr ≠ x")
            case True
            then show ?thesis
              using disconnected_nodes_eq2_h2[OF ‹old_document ≠ x›]
                disconnected_nodes_eq2_h3[OF ‹document_ptr ≠ x›] 4
              by(auto)
          next
            case False
            then show ?thesis
              using  disc_nodes_document_ptr_h3 disc_nodes_document_ptr_h' 4
                ‹child ∉ set disc_nodes_document_ptr_h3›
              by(auto simp add: disconnected_nodes_eq2_h2[OF ‹old_document ≠ x›] )
          qed
        next
          case False
          then show ?thesis
            by (metis (no_types, opaque_lifting) ‹distinct disc_nodes_old_document_h2›
                disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 distinct_remove1 docs_neq select_result_I2)
        qed
      next
        fix x y
        assume a0: "x ∈ set (sorted_list_of_set (fset (document_ptr_kinds h')))"
          and a1: "y ∈ set (sorted_list_of_set (fset (document_ptr_kinds h')))"
          and a2: "x ≠ y"

        moreover have 5: "set |h2 ⊢ get_disconnected_nodes x|r ∩
          set |h2 ⊢ get_disconnected_nodes y|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' ⊢ get_disconnected_nodes x|r ∩
          set |h' ⊢ get_disconnected_nodes y|r = {}"
        proof(cases "old_document = x")
          case True
          have "old_document ≠ y"
            using ‹x ≠ y› ‹old_document = x› by simp
          have "document_ptr ≠ x"
            using docs_neq ‹old_document = x› 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] ‹old_document = x›
              by (metis (no_types, lifting) ‹child ∉ set (remove1 child disc_nodes_old_document_h2)›
                  ‹document_ptr ≠ x› 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 ‹old_document = x› docs_neq
                ‹old_document ≠ y›
              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]
                  ‹old_document ≠ x› ‹old_document = y› ‹document_ptr = x›
                apply(simp)
                by (metis (no_types, lifting)
                    ‹child ∉ set (remove1 child disc_nodes_old_document_h2)›
                    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] ‹old_document ≠ x›
                  ‹old_document = y› ‹document_ptr ≠ x›
                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 ⊢ get_disconnected_nodes y|r ∩ set disc_nodes_old_document_h2 = {}"
              by (metis DocumentMonad.ptr_kinds_M_ok DocumentMonad.ptr_kinds_M_ptr_kinds False
                  ‹type_wf h2› 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 ≠ y"
                using ‹x ≠ y› by auto
              have "set |h2 ⊢ get_disconnected_nodes y|r ∩ set disc_nodes_old_document_h2 = {}"
                using ‹set |h2 ⊢ get_disconnected_nodes y|r ∩ set disc_nodes_old_document_h2 = {}›
                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] ‹old_document ≠ x›
                  ‹old_document ≠ y› ‹document_ptr = x› ‹document_ptr ≠ y›
                  ‹child ∈ set disc_nodes_old_document_h2› disconnected_nodes_eq2_h2
                  disconnected_nodes_eq2_h3 ‹set |h2 ⊢ get_disconnected_nodes y|r ∩ set disc_nodes_old_document_h2 = {}›
                by(auto)
            next
              case False
              then show ?thesis
              proof(cases "document_ptr = y")
                case True
                have f1: "set |h2 ⊢ get_disconnected_nodes x|r ∩ set disc_nodes_document_ptr_h3 = {}"
                  using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2
                    document_ptr_kinds_eq2_h3 ‹document_ptr ≠ x›
                    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 ⊢ get_disconnected_nodes x|r ∩
set |h2 ⊢ get_disconnected_nodes old_document|r = {}"
                  using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2
                    document_ptr_kinds_eq2_h3 ‹old_document ≠ x›
                  by (metis (no_types, lifting) a0 distinct_concat_map_E(1)
                      document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 finite_fset
                      set_sorted_list_of_set)
                ultimately show ?thesis
                  using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                    select_result_I2[OF disc_nodes_old_document_h2] ‹old_document ≠ x›
                    ‹document_ptr ≠ x› ‹document_ptr = y›
                    ‹child ∈ set disc_nodes_old_document_h2› 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] ‹old_document ≠ x›
                    ‹document_ptr ≠ x› ‹document_ptr ≠ y›
                    ‹child ∈ set disc_nodes_old_document_h2› disconnected_nodes_eq2_h2
                    disconnected_nodes_eq2_h3
                  by (metis ‹set |h2 ⊢ get_disconnected_nodes y|r ∩
                  set disc_nodes_old_document_h2 = {}› empty_iff inf.idem)
              qed
            qed
          qed
        qed
      qed
    next
      fix x xa xb
      assume 0: "distinct (concat (map (λptr. |h' ⊢ get_child_nodes ptr|r)
          (sorted_list_of_set (fset (object_ptr_kinds h')))))"
        and 1: "distinct (concat (map (λdocument_ptr. |h2 ⊢ get_disconnected_nodes document_ptr|r)
          (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
        and 2: "(⋃x∈fset (object_ptr_kinds h'). set |h' ⊢ get_child_nodes x|r) ∩
          (⋃x∈fset (document_ptr_kinds h2). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
        and 3: "xa |∈| object_ptr_kinds h'"
        and 4: "x ∈ set |h' ⊢ get_child_nodes xa|r"
        and 5: "xb |∈| document_ptr_kinds h'"
        and 6: "x ∈ set |h' ⊢ get_disconnected_nodes xb|r"
      then show False
        using ‹child ∈ set disc_nodes_old_document_h2› 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 ⊢ get_disconnected_nodes old_document →r disc_nodes_old_document_h2"
        assume a3: "h3 ⊢ get_disconnected_nodes old_document →r remove1 child disc_nodes_old_document_h2"
        assume a4: "x ∈ set |h' ⊢ get_child_nodes xa|r"
        assume "document_ptr_kinds h2 = document_ptr_kinds h'"
        assume a5: "(⋃x∈fset (object_ptr_kinds h'). set |h' ⊢ get_child_nodes x|r) ∩
          (⋃x∈fset (document_ptr_kinds h'). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
        have f6: "old_document |∈| document_ptr_kinds h'"
          using a1 ‹xb |∈| document_ptr_kinds h'› by blast
        have f7: "|h2 ⊢ get_disconnected_nodes old_document|r = disc_nodes_old_document_h2"
          using a2 by simp
        have "x ∈ set disc_nodes_old_document_h2"
          using f6 a3 a1 by (metis (no_types) ‹type_wf h'›
              ‹x ∈ set |h' ⊢ get_disconnected_nodes xb|r› 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' ⊢ get_child_nodes xa|r ∩  set |h2 ⊢ get_disconnected_nodes xb|r = {}"
          using f7 f6 a5 a4 ‹xa |∈| object_ptr_kinds h'›
          by fastforce
        then show ?thesis
          using ‹x ∈ set disc_nodes_old_document_h2› a1 a4 f7 by blast
      next
        assume a1: "xb ≠ old_document"
        assume a2: "h2 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_document_ptr_h3"
        assume a3: "h2 ⊢ get_disconnected_nodes old_document →r disc_nodes_old_document_h2"
        assume a4: "xa |∈| object_ptr_kinds h'"
        assume a5: "h' ⊢ get_disconnected_nodes document_ptr →r child # disc_nodes_document_ptr_h3"
        assume a6: "old_document |∈| document_ptr_kinds h'"
        assume a7: "x ∈ set |h' ⊢ get_disconnected_nodes xb|r"
        assume a8: "x ∈ set |h' ⊢ get_child_nodes xa|r"
        assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'"
        assume a10: "⋀doc_ptr. old_document ≠ doc_ptr ⟹
          |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h3 ⊢ get_disconnected_nodes doc_ptr|r"
        assume a11: "⋀doc_ptr. document_ptr ≠ doc_ptr ⟹ |h3 ⊢ get_disconnected_nodes doc_ptr|r =
          |h' ⊢ get_disconnected_nodes doc_ptr|r"
        assume a12: "(⋃x∈fset (object_ptr_kinds h'). set |h' ⊢ get_child_nodes x|r) ∩
          (⋃x∈fset (document_ptr_kinds h'). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
        have f13: "⋀d. d ∉ set |h' ⊢ document_ptr_kinds_M|r ∨ h2 ⊢ ok get_disconnected_nodes d"
          using a9 ‹type_wf h2› get_disconnected_nodes_ok
          by simp
        then have f14: "|h2 ⊢ get_disconnected_nodes old_document|r = disc_nodes_old_document_h2"
          using a6 a3 by simp
        have "x ∉ set |h2 ⊢ get_disconnected_nodes xb|r"
          using a12 a8 a4 ‹xb |∈| document_ptr_kinds h'›
          by (meson UN_I disjoint_iff_not_equal)
        then have "x = child"
          using f13 a11 a10 a7 a5 a2 a1
          by (metis (no_types, lifting) select_result_I2 set_ConsD)
        then have "child ∉ set disc_nodes_old_document_h2"
          using f14 a12 a8 a6 a4
          by (metis ‹type_wf h'› 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 ‹child ∈ set disc_nodes_old_document_h2› by fastforce
      qed
    qed
    ultimately have "heap_is_wellformedCore_DOM h'"
      using ‹CD.a_owner_document_valid h'› CD.heap_is_wellformed_def
      by simp



    have shadow_root_eq_h2:
      "⋀ptr' shadow_root_ptr_opt. h2 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt =
  h3 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt"
      using get_shadow_root_reads set_disconnected_nodes_writes h3
      apply(rule reads_writes_preserved)
      by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
          set_disconnected_nodes_get_shadow_root)
    then
    have shadow_root_eq2_h2: "⋀ptr'. |h2 ⊢ get_shadow_root ptr'|r = |h3 ⊢ get_shadow_root ptr'|r"
      by (meson select_result_eq)

    have shadow_root_eq_h3:
      "⋀ptr' shadow_root_ptr_opt. h3 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt =
h' ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt"
      using get_shadow_root_reads set_disconnected_nodes_writes h'
      apply(rule reads_writes_preserved)
      by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
          set_disconnected_nodes_get_shadow_root)
    then
    have shadow_root_eq2_h3: "⋀ptr'. |h3 ⊢ get_shadow_root ptr'|r = |h' ⊢ get_shadow_root ptr'|r"
      by (meson select_result_eq)

    have tag_name_eq_h2: "⋀ptr' tag. h2 ⊢ get_tag_name ptr' →r tag = h3 ⊢ get_tag_name ptr' →r tag"
      using get_tag_name_reads set_disconnected_nodes_writes h3
      apply(rule reads_writes_preserved)
      by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
          set_disconnected_nodes_get_tag_name)
    then
    have tag_name_eq2_h2: "⋀ptr'. |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
      by (meson select_result_eq)

    have tag_name_eq_h3: "⋀ptr' tag. h3 ⊢ get_tag_name ptr' →r tag = h' ⊢ get_tag_name ptr' →r tag"
      using get_tag_name_reads set_disconnected_nodes_writes h'
      apply(rule reads_writes_preserved)
      by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
          set_disconnected_nodes_get_tag_name)
    then
    have tag_name_eq2_h3: "⋀ptr'. |h3 ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
      by (meson select_result_eq)

    have object_ptr_kinds_eq_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
      apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
            OF set_disconnected_nodes_writes h3])
      unfolding adopt_node_locs_def remove_child_locs_def
      using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
      by (auto simp add: reflp_def transp_def  split: if_splits)

    have object_ptr_kinds_eq_h3: "object_ptr_kinds h3 = object_ptr_kinds h'"
      apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
            OF set_disconnected_nodes_writes h'])
      unfolding adopt_node_locs_def remove_child_locs_def
      using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
      by (auto simp add: reflp_def transp_def  split: if_splits)

    have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h3"
      using object_ptr_kinds_eq_h2
      by(auto simp add: shadow_root_ptr_kinds_def)
    have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h3"
      using object_ptr_kinds_eq_h2
      by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)

    have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h'"
      using object_ptr_kinds_eq_h3
      by(auto simp add: shadow_root_ptr_kinds_def)
    have element_ptr_kinds_eq_h3: "element_ptr_kinds h3 = element_ptr_kinds h'"
      using object_ptr_kinds_eq_h3
      by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)


    have "known_ptrs h3"
      using known_ptrs local.known_ptrs_preserved object_ptr_kinds_h2_eq3 object_ptr_kinds_h_eq3
      by blast
    then have "known_ptrs h'"
      using local.known_ptrs_preserved object_ptr_kinds_h3_eq3 by blast


    show "heap_is_wellformed h' ∧ known_ptrs h' ∧ type_wf h'"
      using ‹heap_is_wellformed h2›
      using ‹heap_is_wellformedCore_DOM h'› ‹known_ptrs h'› ‹type_wf h'›
      using ‹parent_child_rel h' ⊆ parent_child_rel h2›
      apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
          a_host_shadow_root_rel_def a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def
          object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h3
          shadow_root_ptr_kinds_eq_h2 shadow_root_ptr_kinds_eq_h3  shadow_root_eq_h2 shadow_root_eq_h3
          shadow_root_eq2_h2 shadow_root_eq2_h3 tag_name_eq_h2 tag_name_eq_h3 tag_name_eq2_h2
          tag_name_eq2_h3 CD.parent_child_rel_def children_eq2_h2 children_eq2_h3 object_ptr_kinds_h2_eq3
          object_ptr_kinds_h3_eq3)[1]
      done
  qed
  then show "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
    by auto
qed


lemma adopt_node_node_in_disconnected_nodes:
  assumes wellformed: "heap_is_wellformed h"
    and adopt_node: "h ⊢ adopt_node owner_document node_ptr →h h'"
    and "h' ⊢ get_disconnected_nodes owner_document →r disc_nodes"
    and known_ptrs: "known_ptrs h"
    and type_wf: "type_wf h"
  shows "node_ptr ∈ set disc_nodes"
proof -
  obtain old_document parent_opt h2 where
    old_document: "h ⊢ get_owner_document (cast node_ptr) →r old_document" and
    parent_opt: "h ⊢ get_parent node_ptr →r parent_opt" and
    h2: "h ⊢ (case parent_opt of Some parent ⇒ remove_child parent node_ptr | None ⇒ return ()) →h h2" and
    h': "h2 ⊢ (if owner_document ≠ old_document then do {
        old_disc_nodes ← get_disconnected_nodes old_document;
        set_disconnected_nodes old_document (remove1 node_ptr old_disc_nodes);
        disc_nodes ← get_disconnected_nodes owner_document;
        set_disconnected_nodes owner_document (node_ptr # disc_nodes)
      } else do {
        return ()
      }) →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' ⊢ get_disconnected_nodes owner_document →r disc_nodes"
      assume a2: "⋀h document_ptr disc_nodes h'.
        h ⊢ set_disconnected_nodes document_ptr disc_nodes →h h' ⟹
        h' ⊢ get_disconnected_nodes document_ptr →r disc_nodes"
      assume "h'a ⊢ set_disconnected_nodes owner_document (node_ptr # xb) →h h'"
      then have "node_ptr # xb = disc_nodes"
        using a2 a1 by (meson returns_result_eq)
      then show ?thesis
        by (meson list.set_intros(1))
    qed
  qed
qed
end

interpretation l_adopt_node_wfCore_DOM Shadow_DOM.get_owner_document Shadow_DOM.get_parent
  Shadow_DOM.get_parent_locs Shadow_DOM.remove_child Shadow_DOM.remove_child_locs
  get_disconnected_nodes get_disconnected_nodes_locs
  set_disconnected_nodes set_disconnected_nodes_locs Shadow_DOM.adopt_node Shadow_DOM.adopt_node_locs
  ShadowRootClass.known_ptr ShadowRootClass.type_wf Shadow_DOM.get_child_nodes
  Shadow_DOM.get_child_nodes_locs
  ShadowRootClass.known_ptrs Shadow_DOM.set_child_nodes Shadow_DOM.set_child_nodes_locs
  Shadow_DOM.remove Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel
  by(auto simp add: l_adopt_node_wfCore_DOM_def instances)
declare l_adopt_node_wfCore_DOM_axioms [instances]

interpretation i_adopt_node_wf2?: l_adopt_node_wf2Shadow_DOM
  type_wf known_ptr get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs set_child_nodes set_child_nodes_locs get_shadow_root get_shadow_root_locs
  set_disconnected_nodes set_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed
  parent_child_rel heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs get_root_node get_root_node_locs get_parent get_parent_locs known_ptrs
  get_owner_document remove_child remove_child_locs remove adopt_node adopt_node_locs
  by(auto simp add: l_adopt_node_wf2Shadow_DOM_def instances)
declare l_adopt_node_wf2Shadow_DOM_axioms [instances]


lemma adopt_node_wf_is_l_adopt_node_wf [instances]:
  "l_adopt_node_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes
  get_disconnected_nodes known_ptrs adopt_node"
  apply(auto simp add: l_adopt_node_wf_def l_adopt_node_wf_axioms_def instances)[1]
  using adopt_node_preserves_wellformedness apply blast
  using adopt_node_removes_child apply blast
  using adopt_node_node_in_disconnected_nodes apply blast
  using adopt_node_removes_first_child apply blast
  using adopt_node_document_in_heap apply blast
  using adopt_node_preserves_wellformedness apply blast
  using adopt_node_preserves_wellformedness apply blast
  done


subsubsection ‹insert\_before›

locale l_insert_before_wf2Shadow_DOM =
  l_get_child_nodes +
  l_get_disconnected_nodes +
  l_set_child_nodes_get_shadow_root +
  l_set_disconnected_nodes_get_shadow_root +
  l_set_child_nodes_get_tag_name +
  l_set_disconnected_nodes_get_tag_name +
  l_set_disconnected_nodes_get_disconnected_nodes +
  l_set_child_nodes_get_disconnected_nodes +
  l_set_disconnected_nodes_get_disconnected_nodes_wf +
  l_set_disconnected_nodes_get_ancestors_si +
  l_insert_beforeCore_DOM _ _ _ _ _ _ get_ancestors_si get_ancestors_si_locs +
  l_get_root_node_si_wfShadow_DOM  +
  l_get_owner_document  +
  l_adopt_node  +
  l_adopt_node_wf  +
  l_heap_is_wellformedShadow_DOM +
  l_adopt_node_get_shadow_root
begin
lemma insert_before_child_preserves:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ insert_before ptr node child →h h'"
  shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
proof -
  obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
    ancestors: "h ⊢ get_ancestors_si ptr →r ancestors" and
    node_not_in_ancestors: "cast node ∉ set ancestors" and
    reference_child:
    "h ⊢ (if Some node = child then a_next_sibling node else return child) →r reference_child" and
    owner_document: "h ⊢ get_owner_document ptr →r owner_document" and
    h2: "h ⊢ adopt_node owner_document node →h h2" and
    disconnected_nodes_h2: "h2 ⊢ get_disconnected_nodes owner_document →r disconnected_nodes_h2" and
    h3: "h2 ⊢ set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) →h h3" and
    h': "h3 ⊢ a_insert_node ptr node reference_child →h h'"
    (* children: "h3 ⊢ get_child_nodes ptr →r children" and *)
    (* h': "h3 ⊢ set_child_nodes ptr (insert_before_list node reference_child children) →h h'" *)
    using assms(4)
    by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def
        elim!: bind_returns_heap_E bind_returns_result_E
        bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated]
        bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
        split: if_splits option.splits)

  have "type_wf h2"
    using ‹type_wf h›
    using writes_small_big[where P="λh h'. type_wf h ⟶ type_wf h'", OF adopt_node_writes h2]
    using adopt_node_types_preserved
    by(auto simp add: reflp_def transp_def)
  then have "type_wf h3"
    using writes_small_big[where P="λh h'. type_wf h ⟶ 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="λh h'. type_wf h ⟶ type_wf h'", OF insert_node_writes h']
    using set_child_nodes_types_preserved
    by(auto simp add: reflp_def transp_def)

  have "object_ptr_kinds h = object_ptr_kinds h2"
    using adopt_node_writes h2
    apply(rule writes_small_big)
    using adopt_node_pointers_preserved
    by(auto simp add: reflp_def transp_def)
  moreover have "… = object_ptr_kinds h3"
    using set_disconnected_nodes_writes h3
    apply(rule writes_small_big)
    using set_disconnected_nodes_pointers_preserved
    by(auto simp add: reflp_def transp_def)
  moreover have "… = object_ptr_kinds h'"
    using insert_node_writes h'
    apply(rule writes_small_big)
    using set_child_nodes_pointers_preserved
    by(auto simp add: reflp_def transp_def)

  ultimately
  show "known_ptrs h'"
    using ‹known_ptrs h› known_ptrs_preserved
    by blast

  have "known_ptrs h2"
    using ‹known_ptrs h› known_ptrs_preserved ‹object_ptr_kinds h = object_ptr_kinds h2›
    by blast
  then
  have "known_ptrs h3"
    using known_ptrs_preserved ‹object_ptr_kinds h2 = object_ptr_kinds h3›
    by blast

  have "known_ptr ptr"
    by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I ‹known_ptrs h›
        l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)

  have object_ptr_kinds_M_eq3_h: "object_ptr_kinds h = object_ptr_kinds h2"
    apply(rule writes_small_big[where P="λ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:
    "⋀ptrs. h ⊢ object_ptr_kinds_M →r ptrs = h2 ⊢ object_ptr_kinds_M →r ptrs"
    by(simp add: object_ptr_kinds_M_defs )
  then have object_ptr_kinds_M_eq2_h: "|h ⊢ object_ptr_kinds_M|r = |h2 ⊢ object_ptr_kinds_M|r"
    by simp
  then have node_ptr_kinds_eq2_h: "|h ⊢ node_ptr_kinds_M|r = |h2 ⊢ node_ptr_kinds_M|r"
    using node_ptr_kinds_M_eq by blast

  have wellformed_h2: "heap_is_wellformed h2"
    using adopt_node_preserves_wellformedness[OF ‹heap_is_wellformed h› h2] ‹known_ptrs h›
      ‹type_wf h›
    .

  have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λ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:
    "⋀ptrs. h2 ⊢ object_ptr_kinds_M →r ptrs = h3 ⊢ object_ptr_kinds_M →r ptrs"
    by(simp add: object_ptr_kinds_M_defs)
  then have object_ptr_kinds_M_eq2_h2: "|h2 ⊢ object_ptr_kinds_M|r = |h3 ⊢ object_ptr_kinds_M|r"
    by simp
  then have node_ptr_kinds_eq2_h2: "|h2 ⊢ node_ptr_kinds_M|r = |h3 ⊢ node_ptr_kinds_M|r"
    using node_ptr_kinds_M_eq by blast
  have document_ptr_kinds_eq2_h2: "|h2 ⊢ document_ptr_kinds_M|r = |h3 ⊢ document_ptr_kinds_M|r"
    using object_ptr_kinds_M_eq2_h2 document_ptr_kinds_M_eq by auto

  have object_ptr_kinds_M_eq3_h': "object_ptr_kinds h3 = object_ptr_kinds h'"
    apply(rule writes_small_big[where P="λ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:
    "⋀ptrs. h3 ⊢ object_ptr_kinds_M →r ptrs = h' ⊢ object_ptr_kinds_M →r ptrs"
    by(simp add: object_ptr_kinds_M_defs)
  then have object_ptr_kinds_M_eq2_h3: "|h3 ⊢ object_ptr_kinds_M|r = |h' ⊢ object_ptr_kinds_M|r"
    by simp
  then have node_ptr_kinds_eq2_h3: "|h3 ⊢ node_ptr_kinds_M|r = |h' ⊢ node_ptr_kinds_M|r"
    using node_ptr_kinds_M_eq by blast
  have document_ptr_kinds_eq2_h3: "|h3 ⊢ document_ptr_kinds_M|r = |h' ⊢ document_ptr_kinds_M|r"
    using object_ptr_kinds_M_eq2_h3 document_ptr_kinds_M_eq by auto


  have shadow_root_eq_h2:
    "⋀ptr' shadow_root. h ⊢ get_shadow_root ptr' →r shadow_root =
  h2 ⊢ get_shadow_root ptr' →r shadow_root"
    using get_shadow_root_reads adopt_node_writes h2
    apply(rule reads_writes_preserved)
    using local.adopt_node_get_shadow_root by blast

  have disconnected_nodes_eq_h2:
    "⋀doc_ptr disc_nodes. owner_document ≠ doc_ptr ⟹
      h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h3 ⊢ get_disconnected_nodes doc_ptr →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:
    "⋀doc_ptr. doc_ptr ≠ owner_document ⟹
      |h2 ⊢ get_disconnected_nodes doc_ptr|r =
      |h3 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have disconnected_nodes_h3:
    "h3 ⊢ get_disconnected_nodes owner_document →r remove1 node disconnected_nodes_h2"
    using h3 set_disconnected_nodes_get_disconnected_nodes
    by blast

  have disconnected_nodes_eq_h3:
    "⋀doc_ptr disc_nodes. h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
      h' ⊢ get_disconnected_nodes doc_ptr →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:
    "⋀doc_ptr. |h3 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force

  have children_eq_h2:
    "⋀ptr' children. h2 ⊢ get_child_nodes ptr' →r children = h3 ⊢ get_child_nodes ptr' →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: "⋀ptr'. |h2 ⊢ get_child_nodes ptr'|r = |h3 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force

  have children_eq_h3:
    "⋀ptr' children. ptr ≠ ptr' ⟹
       h3 ⊢ get_child_nodes ptr' →r children = h' ⊢ get_child_nodes ptr' →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:
    "⋀ptr'. ptr ≠ ptr' ⟹ |h3 ⊢ get_child_nodes ptr'|r = |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  obtain children_h3 where children_h3: "h3 ⊢ get_child_nodes ptr →r children_h3"
    using h' a_insert_node_def by auto
  have children_h': "h' ⊢ get_child_nodes ptr →r insert_before_list node reference_child children_h3"
    using h' ‹type_wf h3› ‹known_ptr ptr›
    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 |∈| object_ptr_kinds h3"
    using children_h3 get_child_nodes_ptr_in_heap by blast
  have node_in_heap: "node |∈| node_ptr_kinds h"
    using h2 adopt_node_child_in_heap by fast
  have child_not_in_any_children:
    "⋀p children. h2 ⊢ get_child_nodes p →r children ⟹ node ∉ set children"
    using ‹heap_is_wellformed h› h2 adopt_node_removes_child ‹type_wf h› ‹known_ptrs h› by auto
  have "node ∈ set disconnected_nodes_h2"
    using disconnected_nodes_h2 h2 adopt_node_node_in_disconnected_nodes assms(1)
      ‹type_wf h› ‹known_ptrs h› by blast
  have node_not_in_disconnected_nodes:
    "⋀d. d |∈| document_ptr_kinds h3 ⟹ node ∉ set |h3 ⊢ get_disconnected_nodes d|r"
  proof -
    fix d
    assume "d |∈| document_ptr_kinds h3"
    show "node ∉ set |h3 ⊢ get_disconnected_nodes d|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 ‹d |∈| document_ptr_kinds h3› disconnected_nodes_h3
        by fastforce
    next
      case False
      then have "set |h2 ⊢ get_disconnected_nodes d|r ∩ set |h2 ⊢ get_disconnected_nodes owner_document|r = {}"
        using distinct_concat_map_E(1) wellformed_h2
        by (metis (no_types, lifting) ‹d |∈| document_ptr_kinds h3› ‹type_wf h2›
            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] ‹node ∈ set disconnected_nodes_h2›
          disconnected_nodes_h2 by fastforce
    qed
  qed

  have "cast node ≠ ptr"
    using ancestors node_not_in_ancestors get_ancestors_ptr
    by fast

  obtain ancestors_h2 where ancestors_h2: "h2 ⊢ get_ancestors_si ptr →r ancestors_h2"
    using get_ancestors_si_ok
    by (metis ‹known_ptrs h2› ‹type_wf h2› is_OK_returns_result_E
        object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2)
  have ancestors_h3: "h3 ⊢ get_ancestors_si ptr →r ancestors_h2"
    using get_ancestors_si_reads set_disconnected_nodes_writes h3
    apply(rule reads_writes_separate_forwards)
    using  ‹heap_is_wellformed h2› apply simp
    using ancestors_h2 apply simp
    apply(auto simp add: get_ancestors_si_locs_def get_parent_locs_def)[1]
     apply (simp add: local.get_ancestors_si_locs_def local.get_parent_reads_pointers
        local.set_disconnected_nodes_get_ancestors_si)
    using local.get_ancestors_si_locs_def local.set_disconnected_nodes_get_ancestors_si by blast
  have node_not_in_ancestors_h2: "cast node ∉ set ancestors_h2"
    using ‹heap_is_wellformed h› ‹heap_is_wellformed h2› ancestors ancestors_h2
    apply(rule get_ancestors_si_remains_not_in_ancestors)
    using assms(2) assms(3) h2 local.adopt_node_children_subset apply blast
    using shadow_root_eq_h2 node_not_in_ancestors object_ptr_kinds_M_eq2_h assms(2) assms(3)
      ‹type_wf h2›
    by(auto dest: returns_result_eq)

  moreover
  have "parent_child_rel h2 = parent_child_rel h3"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
  have "parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))"
    using children_h3 children_h' ptr_in_heap
    apply(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h' children_eq2_h3
        insert_before_list_node_in_set)[1]
     apply (metis (no_types, lifting) children_eq2_h3 insert_before_list_in_set select_result_I2)
    by (metis (no_types, lifting) children_eq2_h3 imageI insert_before_list_in_set select_result_I2)
  have "CD.a_acyclic_heap h'"
  proof -
    have "acyclic (parent_child_rel h2)"
      using wellformed_h2
      by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
    then have "acyclic (parent_child_rel h3)"
      by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
    moreover have "cast node ∉ {x. (x, ptr) ∈ (parent_child_rel h2)*}"
      using get_ancestors_si_parent_child_rel
      using ‹known_ptrs h2› ‹type_wf h2› ancestors_h2 node_not_in_ancestors_h2 wellformed_h2
      by blast
    then have "cast node ∉ {x. (x, ptr) ∈ (parent_child_rel h3)*}"
      by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
    ultimately show ?thesis
      using ‹parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))›
      by(auto simp add: CD.acyclic_heap_def)
  qed


  moreover have "CD.a_all_ptrs_in_heap h2"
    using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  have "CD.a_all_ptrs_in_heap h'"
  proof -
    have "CD.a_all_ptrs_in_heap h3"
      using ‹CD.a_all_ptrs_in_heap h2›
      apply(auto simp add: CD.a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2
          node_ptr_kinds_eq2_h2 children_eq_h2)[1]
      using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3
      using node_ptr_kinds_eq2_h2 apply auto[1]
       apply (metis (no_types, opaque_lifting) children_eq2_h2 in_mono object_ptr_kinds_M_eq3_h2)
      by (metis (no_types, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h2
          disconnected_nodes_h2 disconnected_nodes_h3 document_ptr_kinds_commutes
          node_ptr_kinds_eq2_h2 object_ptr_kinds_M_eq3_h2 select_result_I2 set_remove1_subset subsetD)
    have "set children_h3  ⊆ set |h' ⊢ node_ptr_kinds_M|r"
      using children_h3 ‹CD.a_all_ptrs_in_heap h3›
      apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq2_h3)[1]
      using CD.parent_child_rel_child_nodes2 ‹known_ptr ptr›
        ‹parent_child_rel h2 = parent_child_rel h3› ‹type_wf h2›
        local.parent_child_rel_child_in_heap node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h'
        object_ptr_kinds_M_eq3_h2 wellformed_h2 by blast
    then have "set (insert_before_list node reference_child children_h3) ⊆ set |h' ⊢ node_ptr_kinds_M|r"
      using node_in_heap
      apply(auto simp add: node_ptr_kinds_eq2_h node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3)[1]
      by (metis (no_types, opaque_lifting) contra_subsetD insert_before_list_in_set
          node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2)
    then show ?thesis
      using ‹CD.a_all_ptrs_in_heap h3›
      apply(auto simp add: object_ptr_kinds_M_eq3_h' CD.a_all_ptrs_in_heap_def node_ptr_kinds_def
          node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1]
      using children_eq_h3 children_h'
       apply (metis (no_types, lifting) children_eq2_h3 select_result_I2 subsetD)
      by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h3
          document_ptr_kinds_eq2_h3 subsetD)
  qed


  moreover have "CD.a_distinct_lists h2"
    using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def )
  then have "CD.a_distinct_lists h3"
  proof(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2
      children_eq2_h2 intro!: distinct_concat_map_I)
    fix x
    assume 1: "x |∈| document_ptr_kinds h3"
      and 2: "distinct (concat (map (λdocument_ptr. |h2 ⊢ get_disconnected_nodes document_ptr|r)
(sorted_list_of_set (fset (document_ptr_kinds h3)))))"
    show "distinct |h3 ⊢ get_disconnected_nodes x|r"
      using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3]
        disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1
      by (metis (full_types) distinct_remove1 finite_fset set_sorted_list_of_set)
  next
    fix x y xa
    assume 1: "distinct (concat (map (λdocument_ptr. |h2 ⊢ get_disconnected_nodes document_ptr|r)
(sorted_list_of_set (fset (document_ptr_kinds h3)))))"
      and 2: "x |∈| document_ptr_kinds h3"
      and 3: "y |∈| document_ptr_kinds h3"
      and 4: "x ≠ y"
      and 5: "xa ∈ set |h3 ⊢ get_disconnected_nodes x|r"
      and 6: "xa ∈ set |h3 ⊢ get_disconnected_nodes y|r"
    show False
    proof (cases "x = owner_document")
      case True
      then have "y ≠ 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 ‹y ≠ owner_document›])[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 ‹x ≠ owner_document›])[1]
          by (metis (no_types, opaque_lifting) disconnected_nodes_eq2_h2 disjoint_iff_not_equal
              notin_set_remove1)
      next
        case False
        then show ?thesis
          using distinct_concat_map_E(1)[OF 1, simplified, OF 2 3 4] 5 6
          using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3
            disjoint_iff_not_equal notin_set_remove1 select_result_I2
          by (metis (no_types, opaque_lifting))
      qed
    qed
  next
    fix x xa xb
    assume 1: "(⋃x∈fset (object_ptr_kinds h3). set |h3 ⊢ get_child_nodes x|r) ∩
(⋃x∈fset (document_ptr_kinds h3). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
      and 2: "xa |∈| object_ptr_kinds h3"
      and 3: "x ∈ set |h3 ⊢ get_child_nodes xa|r"
      and 4: "xb |∈| document_ptr_kinds h3"
      and 5: "x ∈ set |h3 ⊢ get_disconnected_nodes xb|r"
    have 6: "set |h3 ⊢ get_child_nodes xa|r ∩ set |h2 ⊢ get_disconnected_nodes xb|r = {}"
      using 1 2 4
      by (metis ‹type_wf h2› children_eq2_h2 document_ptr_kinds_commutes ‹known_ptrs h›
          local.get_child_nodes_ok local.get_disconnected_nodes_ok
          local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr
          object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result wellformed_h2)
    show False
    proof (cases "xb = owner_document")
      case True
      then show ?thesis
        using select_result_I2[OF disconnected_nodes_h3,folded select_result_I2[OF disconnected_nodes_h2]]
        by (metis (no_types, lifting) "3" "5" "6" disjoint_iff_not_equal notin_set_remove1)
    next
      case False
      show ?thesis
        using 2 3 4 5 6 unfolding disconnected_nodes_eq2_h2[OF False] by auto
    qed
  qed
  then have "CD.a_distinct_lists h'"
  proof(auto simp add: CD.a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3
      disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)
    fix x
    assume 1: "distinct (concat (map (λptr. |h3 ⊢ get_child_nodes ptr|r)
(sorted_list_of_set (fset (object_ptr_kinds h')))))" and
      2: "x |∈| object_ptr_kinds h'"
    have 3: "⋀p. p |∈| object_ptr_kinds h' ⟹ distinct |h3 ⊢ get_child_nodes p|r"
      using 1  by (auto elim: distinct_concat_map_E)
    show "distinct |h' ⊢ get_child_nodes x|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 (λptr. |h3 ⊢ get_child_nodes ptr|r)
(sorted_list_of_set (fset (object_ptr_kinds h')))))"
      and 2: "x |∈| object_ptr_kinds h'"
      and 3: "y |∈| object_ptr_kinds h'"
      and 4: "x ≠ y"
      and 5: "xa ∈ set |h' ⊢ get_child_nodes x|r"
      and 6: "xa ∈ set |h' ⊢ get_child_nodes y|r"
    have 7:"set |h3 ⊢ get_child_nodes x|r ∩ set |h3 ⊢ get_child_nodes y|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 ≠ 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 ‹ptr ≠ y›])[1]
        by (metis (no_types, opaque_lifting) "3" "7" ‹type_wf h3› children_eq2_h3 disjoint_iff_not_equal
            get_child_nodes_ok insert_before_list_in_set ‹known_ptrs h› 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 ‹ptr ≠ x›])[1]
          by (metis (no_types, opaque_lifting) "2" "4" "7" IntI ‹known_ptrs h3› ‹type_wf h'›
              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 ‹ptr ≠ x›] children_eq2_h3[OF ‹ptr ≠ y›] 5 6 7 by auto
      qed
    qed
  next
    fix x xa xb
    assume 1: " (⋃x∈fset (object_ptr_kinds h'). set |h3 ⊢ get_child_nodes x|r) ∩
(⋃x∈fset (document_ptr_kinds h'). set |h' ⊢ get_disconnected_nodes x|r) = {} "
      and 2: "xa |∈| object_ptr_kinds h'"
      and 3: "x ∈ set |h' ⊢ get_child_nodes xa|r"
      and 4: "xb |∈| document_ptr_kinds h'"
      and 5: "x ∈ set |h' ⊢ get_disconnected_nodes xb|r"
    have 6: "set |h3 ⊢ get_child_nodes xa|r ∩ set |h' ⊢ get_disconnected_nodes xb|r = {}"
      using 1 2 3 4 5
    proof -
      have "∀h d. ¬ type_wf h ∨ d |∉| document_ptr_kinds h ∨ h ⊢ ok get_disconnected_nodes d"
        using local.get_disconnected_nodes_ok by satx
      then have "h' ⊢ ok get_disconnected_nodes xb"
        using "4" ‹type_wf h'› by fastforce
      then have f1: "h3 ⊢ get_disconnected_nodes xb →r |h' ⊢ get_disconnected_nodes xb|r"
        by (simp add: disconnected_nodes_eq_h3)
      have "xa |∈| object_ptr_kinds h3"
        using "2" object_ptr_kinds_M_eq3_h' by blast
      then show ?thesis
        using f1 ‹local.CD.a_distinct_lists h3› CD.distinct_lists_no_parent by fastforce
    qed
    show False
    proof (cases "ptr = xa")
      case True
      show ?thesis
        using 6 node_not_in_disconnected_nodes  3 4 5  select_result_I2[OF children_h']
          select_result_I2[OF children_h3] True disconnected_nodes_eq2_h3
        by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M
            ‹CD.a_distinct_lists h3› ‹type_wf h'› disconnected_nodes_eq_h3 CD.distinct_lists_no_parent
            document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok insert_before_list_in_set
            object_ptr_kinds_M_eq3_h' returns_result_select_result)

    next
      case False
      then show ?thesis
        using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce
    qed
  qed

  moreover have "CD.a_owner_document_valid h2"
    using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h'"
    apply(auto simp add: CD.a_owner_document_valid_def object_ptr_kinds_M_eq2_h2
        object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 document_ptr_kinds_eq2_h2
        document_ptr_kinds_eq2_h3 children_eq2_h2 )[1] thm children_eq2_h3
    apply(auto simp add: document_ptr_kinds_eq2_h2[simplified]  document_ptr_kinds_eq2_h3[simplified]
        object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified]
        node_ptr_kinds_eq2_h2[simplified] node_ptr_kinds_eq2_h3[simplified])[1]
    apply(auto simp add: disconnected_nodes_eq2_h3[symmetric])[1]
    by (metis (no_types, opaque_lifting) Core_DOM_Functions.i_insert_before.insert_before_list_in_set
        children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2
        disconnected_nodes_h3 in_set_remove1 is_OK_returns_result_I object_ptr_kinds_M_eq3_h'
        ptr_in_heap returns_result_eq returns_result_select_result)
  ultimately have "heap_is_wellformedCore_DOM h'"
    by (simp add: CD.heap_is_wellformed_def)

  have shadow_root_eq_h2:
    "⋀ptr' shadow_root_ptr_opt. h2 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt =
h3 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt"
    using get_shadow_root_reads set_disconnected_nodes_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
        set_disconnected_nodes_get_shadow_root)
  then
  have shadow_root_eq2_h2: "⋀ptr'. |h2 ⊢ get_shadow_root ptr'|r = |h3 ⊢ get_shadow_root ptr'|r"
    by (meson select_result_eq)

  have shadow_root_eq_h3:
    "⋀ptr' shadow_root_ptr_opt. h3 ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt =
h' ⊢ get_shadow_root ptr' →r shadow_root_ptr_opt"
    using get_shadow_root_reads insert_node_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
        set_disconnected_nodes_get_shadow_root)
  then
  have shadow_root_eq2_h3: "⋀ptr'. |h3 ⊢ get_shadow_root ptr'|r = |h' ⊢ get_shadow_root ptr'|r"
    by (meson select_result_eq)

  have tag_name_eq_h2: "⋀ptr' tag. h2 ⊢ get_tag_name ptr' →r tag = h3 ⊢ get_tag_name ptr' →r tag"
    using get_tag_name_reads set_disconnected_nodes_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
        set_disconnected_nodes_get_tag_name)
  then
  have tag_name_eq2_h2: "⋀ptr'. |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
    by (meson select_result_eq)

  have tag_name_eq_h3: "⋀ptr' tag. h3 ⊢ get_tag_name ptr' →r tag = h' ⊢ get_tag_name ptr' →r tag"
    using get_tag_name_reads insert_node_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
        set_disconnected_nodes_get_tag_name)
  then
  have tag_name_eq2_h3: "⋀ptr'. |h3 ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
    by (meson select_result_eq)

  have object_ptr_kinds_eq_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
          OF set_disconnected_nodes_writes h3])
    unfolding adopt_node_locs_def remove_child_locs_def
    using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
    by (auto simp add: reflp_def transp_def  split: if_splits)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h3 = object_ptr_kinds h'"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h = object_ptr_kinds h'",
          OF insert_node_writes h'])
    using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
    by (auto simp add: reflp_def transp_def  split: if_splits)

  have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h3"
    using object_ptr_kinds_eq_h2
    by(auto simp add: shadow_root_ptr_kinds_def)
  have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h3"
    using object_ptr_kinds_eq_h2
    by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)

  have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h'"
    using object_ptr_kinds_eq_h3
    by(auto simp add: shadow_root_ptr_kinds_def)
  have element_ptr_kinds_eq_h3: "element_ptr_kinds h3 = element_ptr_kinds h'"
    using object_ptr_kinds_eq_h3
    by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)


  have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq2_h2)
  have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3 shadow_root_eq2_h3)

  have "cast node ∉ {x. (x, ptr) ∈ (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)*}"
    using get_ancestors_si_parent_child_host_shadow_root_rel
    using ‹known_ptrs h2› ‹local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3›
      ‹parent_child_rel h2 = parent_child_rel h3› ‹type_wf h2› ancestors_h2 node_not_in_ancestors_h2
      wellformed_h2
    by auto

  have "acyclic (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)"
    using ‹heap_is_wellformed h2›
    by(auto simp add: heap_is_wellformed_def ‹parent_child_rel h2 = parent_child_rel h3›
        ‹a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3›)
  then
  have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
    apply(auto simp add: ‹a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'›
        ‹parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))›)[1]
    using ‹cast node ∉ {x. (x, ptr) ∈ (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)*}›
    by (simp add: ‹local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'›)
  then
  show "heap_is_wellformed h'"
    using ‹heap_is_wellformed h2›
    using ‹heap_is_wellformedCore_DOM h'›
    apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
        a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def)[1]
    by(auto simp add: object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2
        element_ptr_kinds_eq_h3 shadow_root_ptr_kinds_eq_h2 shadow_root_ptr_kinds_eq_h3  shadow_root_eq_h2
        shadow_root_eq_h3 shadow_root_eq2_h2 shadow_root_eq2_h3 tag_name_eq_h2 tag_name_eq_h3
        tag_name_eq2_h2 tag_name_eq2_h3)

qed
end

interpretation i_insert_before_wf?: l_insert_before_wfCore_DOM get_parent get_parent_locs
  get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si
  get_ancestors_si_locs adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_owner_document insert_before
  insert_before_locs append_child type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel
  by(simp add: l_insert_before_wfCore_DOM_def instances)
declare l_insert_before_wfCore_DOM_axioms [instances]

lemma insert_before_wf_is_l_insert_before_wf [instances]:
  "l_insert_before_wf Shadow_DOM.heap_is_wellformed ShadowRootClass.type_wf
ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
     Shadow_DOM.insert_before Shadow_DOM.get_child_nodes"
  apply(auto simp add: l_insert_before_wf_def l_insert_before_wf_axioms_def instances)[1]
  using insert_before_removes_child apply fast
  done

lemma l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]: "l_set_disconnected_nodes_get_disconnected_nodes_wf ShadowRootClass.type_wf
ShadowRootClass.known_ptr Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel Shadow_DOM.get_child_nodes
     get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs"
  apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def
      l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1]
  by (metis Diff_iff Shadow_DOM.i_heap_is_wellformed.heap_is_wellformed_disconnected_nodes_distinct
      Shadow_DOM.i_remove_child.set_disconnected_nodes_get_disconnected_nodes insert_iff
      returns_result_eq set_remove1_eq)

interpretation l_get_root_node_si_wfShadow_DOM
  type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs
  get_host get_host_locs get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
  get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
  get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM
  get_disconnected_document get_disconnected_document_locs
  by(auto simp add: l_get_root_node_si_wfShadow_DOM_def instances)
declare l_get_root_node_si_wfShadow_DOM_axioms [instances]

interpretation i_insert_before_wf2?: l_insert_before_wf2Shadow_DOM type_wf known_ptr get_child_nodes
  get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs set_child_nodes set_child_nodes_locs get_shadow_root get_shadow_root_locs set_disconnected_nodes set_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel get_ancestors_si get_ancestors_si_locs get_parent get_parent_locs adopt_node adopt_node_locs get_owner_document insert_before insert_before_locs append_child known_ptrs get_host get_host_locs get_root_node_si get_root_node_si_locs heap_is_wellformedCore_DOM get_disconnected_document get_disconnected_document_locs
  by(auto simp add: l_insert_before_wf2Shadow_DOM_def instances)
declare l_insert_before_wf2Shadow_DOM_axioms [instances]


lemma insert_before_wf2_is_l_insert_before_wf2 [instances]:
  "l_insert_before_wf2 ShadowRootClass.type_wf ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
Shadow_DOM.insert_before
     Shadow_DOM.heap_is_wellformed"
  apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1]
  using insert_before_child_preserves apply(fast, fast, fast)
  done


subsubsection ‹append\_child›

interpretation i_append_child_wf?: l_append_child_wfCore_DOM get_owner_document get_parent
  get_parent_locs remove_child remove_child_locs
  get_disconnected_nodes get_disconnected_nodes_locs
  set_disconnected_nodes set_disconnected_nodes_locs
  adopt_node adopt_node_locs known_ptr type_wf get_child_nodes
  get_child_nodes_locs known_ptrs set_child_nodes
  set_child_nodes_locs remove get_ancestors_si get_ancestors_si_locs
  insert_before insert_before_locs append_child heap_is_wellformed
  parent_child_rel
  by(auto simp add: l_append_child_wfCore_DOM_def instances)
declare l_append_child_wfCore_DOM_axioms [instances]

lemma append_child_wf_is_l_append_child_wf [instances]:
  "l_append_child_wf type_wf known_ptr known_ptrs append_child heap_is_wellformed"
  apply(auto simp add: l_append_child_wf_def l_append_child_wf_axioms_def instances)[1]
  using append_child_heap_is_wellformed_preserved by fast+


subsubsection ‹to\_tree\_order›

interpretation i_to_tree_order_wf?: l_to_tree_order_wfCore_DOM known_ptr type_wf get_child_nodes
  get_child_nodes_locs to_tree_order known_ptrs get_parent get_parent_locs heap_is_wellformed
  parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
  apply(auto simp add: l_to_tree_order_wfCore_DOM_def instances)[1]
  done
declare l_to_tree_order_wfCore_DOM_axioms [instances]

lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]:
  "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
to_tree_order get_parent get_child_nodes"
  apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def instances)[1]
  using to_tree_order_ok apply fast
  using to_tree_order_ptrs_in_heap apply fast
  using to_tree_order_parent_child_rel apply(fast, fast)
  using to_tree_order_child2 apply blast
  using to_tree_order_node_ptrs apply fast
  using to_tree_order_child apply fast
  using to_tree_order_ptr_in_result apply fast
  using to_tree_order_parent apply fast
  using to_tree_order_subset apply fast
  done


paragraph ‹get\_root\_node›

interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wfCore_DOM
  known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs
  to_tree_order
  by(auto simp add: l_to_tree_order_wf_get_root_node_wfCore_DOM_def instances)
declare l_to_tree_order_wf_get_root_node_wfCore_DOM_axioms [instances]

lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [instances]:
  "l_to_tree_order_wf_get_root_node_wf ShadowRootClass.type_wf ShadowRootClass.known_ptr
ShadowRootClass.known_ptrs to_tree_order Shadow_DOM.get_root_node
     Shadow_DOM.heap_is_wellformed"
  apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def
      l_to_tree_order_wf_get_root_node_wf_axioms_def instances)[1]
  using to_tree_order_get_root_node apply fast
  using to_tree_order_same_root apply fast
  done


subsubsection ‹to\_tree\_order\_si›

locale l_to_tree_order_si_wfShadow_DOM =
  l_get_child_nodes +
  l_get_parent_get_host_wfShadow_DOM +
  l_to_tree_order_siShadow_DOM
begin
lemma to_tree_order_si_ok:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
    and "ptr |∈| object_ptr_kinds h"
  shows "h ⊢ ok (to_tree_order_si ptr)"
proof(insert assms(1) assms(4), induct rule: heap_wellformed_induct_si)
  case (step parent)
  have "known_ptr parent"
    using assms(2) local.known_ptrs_known_ptr step.prems
    by blast
  then show ?case
    using step
    using assms(1) assms(2) assms(3)
    using local.heap_is_wellformed_children_in_heap local.get_shadow_root_shadow_root_ptr_in_heap
    by(auto simp add: to_tree_order_si_def[of parent] intro: get_child_nodes_ok get_shadow_root_ok
        intro!: bind_is_OK_pure_I map_M_pure_I bind_pure_I map_M_ok_I split: option.splits)
qed
end

interpretation i_to_tree_order_si_wf?: l_to_tree_order_si_wfShadow_DOM
  type_wf known_ptr get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name
  get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM
  get_host get_host_locs get_disconnected_document get_disconnected_document_locs
  known_ptrs get_parent get_parent_locs to_tree_order_si
  by(auto simp add: l_to_tree_order_si_wfShadow_DOM_def instances)
declare l_to_tree_order_si_wfShadow_DOM_axioms [instances]


subsubsection ‹get\_assigned\_nodes›

lemma forall_M_small_big: "h ⊢ forall_M f xs →h h' ⟹ P h ⟹
(⋀h h' x. x ∈ set xs ⟹ h ⊢ f x →h h' ⟹ P h ⟹ P h') ⟹ P h'"
  by(induct xs arbitrary: h) (auto elim!: bind_returns_heap_E)

locale l_assigned_nodes_wfShadow_DOM =
  l_assigned_nodesShadow_DOM +
  l_heap_is_wellformed +
  l_remove_child_wf2 +
  l_append_child_wf +
  l_remove_shadow_root_wfShadow_DOM
begin

lemma assigned_nodes_distinct:
  assumes "heap_is_wellformed h"
  assumes "h ⊢ assigned_nodes slot →r nodes"
  shows "distinct nodes"
proof -
  have "⋀ptr children. h ⊢ get_child_nodes ptr →r children ⟹ distinct children"
    using assms(1) local.heap_is_wellformed_children_distinct by blast
  then show ?thesis
    using assms
    apply(auto simp add: assigned_nodes_def elim!: bind_returns_result_E2 split: if_splits)[1]
    by (simp add: filter_M_distinct)
qed


lemma flatten_dom_preserves:
  assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
  assumes "h ⊢ flatten_dom →h h'"
  shows "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
proof -
  obtain tups h2 element_ptrs shadow_root_ptrs where
    "h ⊢ element_ptr_kinds_M →r element_ptrs" and
    tups: "h ⊢ map_filter_M2 (λelement_ptr. do {
      tag ← get_tag_name element_ptr;
      assigned_nodes ← assigned_nodes element_ptr;
      (if tag = ''slot'' ∧ assigned_nodes ≠ [] then
return (Some (element_ptr, assigned_nodes)) else return None)}) element_ptrs →r tups"
    (is "h ⊢ map_filter_M2 ?f element_ptrs →r tups") and
    h2: "h ⊢ forall_M (λ(slot, assigned_nodes). do {
      get_child_nodes (cast slot) ⤜ forall_M remove;
      forall_M (append_child (cast slot)) assigned_nodes
    }) tups →h h2" and
    "h2 ⊢ shadow_root_ptr_kinds_M →r shadow_root_ptrs" and
    h': "h2 ⊢ forall_M (λshadow_root_ptr. do {
      host ← get_host shadow_root_ptr;
      get_child_nodes (cast host) ⤜ forall_M remove;
      get_child_nodes (cast shadow_root_ptr) ⤜ forall_M (append_child (cast host));
      remove_shadow_root host
    }) shadow_root_ptrs →h h'"
    using ‹h ⊢ flatten_dom →h h'›
    apply(auto simp add: flatten_dom_def elim!: bind_returns_heap_E
        bind_returns_heap_E2[rotated, OF ElementMonad.ptr_kinds_M_pure, rotated]
        bind_returns_heap_E2[rotated, OF ShadowRootMonad.ptr_kinds_M_pure, rotated])[1]
    apply(drule pure_returns_heap_eq)
    by(auto intro!: map_filter_M2_pure bind_pure_I)
  have "heap_is_wellformed h2 ∧ known_ptrs h2 ∧ type_wf h2"
    using h2 ‹heap_is_wellformed h› ‹known_ptrs h› ‹type_wf h›
    by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated,
          OF get_child_nodes_pure, rotated]
        elim!: forall_M_small_big[where P = "λh. heap_is_wellformed h ∧ known_ptrs h ∧ type_wf h",
          simplified]
        intro: remove_preserves_known_ptrs remove_heap_is_wellformed_preserved
        remove_preserves_type_wf
        append_child_preserves_known_ptrs append_child_heap_is_wellformed_preserved
        append_child_preserves_type_wf)
  then
  show "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
    using h'
    by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_host_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
        dest!: forall_M_small_big[where P = "λh. heap_is_wellformed h ∧ known_ptrs h ∧ type_wf h",
          simplified]
        intro: remove_preserves_known_ptrs remove_heap_is_wellformed_preserved
        remove_preserves_type_wf
        append_child_preserves_known_ptrs append_child_heap_is_wellformed_preserved
        append_child_preserves_type_wf
        remove_shadow_root_preserves
        )
qed
end

interpretation i_assigned_nodes_wf?: l_assigned_nodes_wfShadow_DOM
  known_ptr assigned_nodes assigned_nodes_flatten flatten_dom get_child_nodes get_child_nodes_locs
  get_tag_name get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
  assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
  remove_shadow_root_locs type_wf get_shadow_root get_shadow_root_locs set_shadow_root
  set_shadow_root_locs get_parent get_parent_locs to_tree_order heap_is_wellformed parent_child_rel
  get_disconnected_nodes get_disconnected_nodes_locs known_ptrs remove_child remove_child_locs
  heap_is_wellformedCore_DOM get_disconnected_document get_disconnected_document_locs
  by(auto simp add: l_assigned_nodes_wfShadow_DOM_def instances)
declare l_assigned_nodes_wfShadow_DOM_axioms [instances]

subsubsection ‹get\_shadow\_root\_safe›

locale l_get_shadow_root_safe_wfShadow_DOM =
  l_heap_is_wellformedShadow_DOM  get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
  known_ptr type_wf heap_is_wellformed parent_child_rel heap_is_wellformedCore_DOM get_host
  get_host_locs +
  l_type_wf type_wf +
  l_get_shadow_root_safeShadow_DOM type_wf get_shadow_root_safe get_shadow_root_safe_locs
  get_shadow_root get_shadow_root_locs get_mode get_mode_locs
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and known_ptrs :: "(_) heap ⇒ bool"
    and type_wf :: "(_) heap ⇒ bool"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root ::
    "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root_safe ::
    "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_safe_locs ::
    "(_) element_ptr ⇒ (_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_child_nodes :: "(_::linorder) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformed :: "(_) heap ⇒ bool"
    and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
    and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
    and get_mode :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, shadow_root_mode) prog"
    and get_mode_locs :: "(_) shadow_root_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
begin


end


subsubsection ‹create\_element›

locale l_create_element_wfShadow_DOM =
  l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
  l_set_tag_name type_wf set_tag_name set_tag_name_locs +
  l_create_element_defs create_element +
  l_heap_is_wellformedShadow_DOM  get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs +
  l_new_element_get_disconnected_nodes get_disconnected_nodes get_disconnected_nodes_locs +
  l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs
  get_disconnected_nodes get_disconnected_nodes_locs +
  l_create_elementShadow_DOM get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
  set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr
  type_wfCore_DOM known_ptrCore_DOM +
  l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs +
  l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr
  get_child_nodes get_child_nodes_locs +
  l_set_tag_name_get_tag_name type_wf get_tag_name get_tag_name_locs set_tag_name set_tag_name_locs +
  l_new_element_get_tag_name type_wf get_tag_name get_tag_name_locs +
  l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs
  get_child_nodes get_child_nodes_locs +
  l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes set_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs +
  l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
  get_tag_name get_tag_name_locs +
  l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs +
  l_set_disconnected_nodes_get_disconnected_nodes  type_wf get_disconnected_nodes
  get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs +
  l_new_element_get_shadow_root type_wf get_shadow_root get_shadow_root_locs +
  l_set_tag_name_get_shadow_root type_wf set_tag_name set_tag_name_locs get_shadow_root
  get_shadow_root_locs +
  l_new_element type_wf +
  l_known_ptrs known_ptr known_ptrs
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and known_ptrs :: "(_) heap ⇒ bool"
    and type_wf :: "(_) heap ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformed :: "(_) heap ⇒ bool"
    and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
    and set_tag_name :: "(_) element_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
    and set_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_disconnected_nodes ::
    "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
    and create_element ::
    "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_document :: "(_) node_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
    and get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and known_ptrCore_DOM :: "(_::linorder) object_ptr ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
begin
lemma create_element_preserves_wellformedness:
  assumes "heap_is_wellformed h"
    and "h ⊢ create_element document_ptr tag →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 ⊢ new_element →r new_element_ptr" and
    h2: "h ⊢ new_element →h h2" and
    h3: "h2 ⊢ set_tag_name new_element_ptr tag →h h3" and
    disc_nodes_h3: "h3 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3" and
    h': "h3 ⊢ set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes_h3) →h h'"
    using assms(2)
    by(auto simp add: create_element_def
        elim!: bind_returns_heap_E
        bind_returns_heap_E2[rotated, OF CD.get_disconnected_nodes_pure, rotated] )
  then have "h ⊢ create_element document_ptr tag →r new_element_ptr"
    apply(auto simp add: create_element_def intro!: bind_returns_result_I)[1]
      apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
     apply (metis is_OK_returns_heap_E is_OK_returns_result_I CD.get_disconnected_nodes_pure
        pure_returns_heap_eq)
    by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)

  have "new_element_ptr ∉ set |h ⊢ element_ptr_kinds_M|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 ∉ set |h ⊢ node_ptr_kinds_M|r"
    by simp
  then have "cast new_element_ptr ∉ set |h ⊢ object_ptr_kinds_M|r"
    by simp

  have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|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 |∪| {|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 |∪| {|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="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_tag_name_writes h3])
    using set_tag_name_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def)
  then have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
    by(simp add: element_ptr_kinds_def)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_disconnected_nodes_writes h'])
    using set_disconnected_nodes_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: node_ptr_kinds_def)
  then have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
    by(simp add: element_ptr_kinds_def)

  have "known_ptr (cast new_element_ptr)"
    using ‹h ⊢ create_element document_ptr tag →r new_element_ptr› local.create_element_known_ptr
    by blast
  then
  have "known_ptrs h2"
    using known_ptrs_new_ptr object_ptr_kinds_eq_h ‹known_ptrs h› 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 |∈| document_ptr_kinds h"
    using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
      CD.get_disconnected_nodes_ptr_in_heap ‹type_wf h› document_ptr_kinds_def
    by (metis is_OK_returns_result_I)

  have children_eq_h: "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_element_ptr
              ⟹ h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h2 get_child_nodes_new_element[rotated, OF new_element_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h: "⋀ptr'. ptr' ≠ cast new_element_ptr
                                    ⟹ |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have "h2 ⊢ get_child_nodes (cast new_element_ptr) →r []"
    using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
      new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes
    by blast
  have tag_name_eq_h:
    "⋀ptr' disc_nodes. ptr' ≠  new_element_ptr
              ⟹ h ⊢ get_tag_name ptr' →r disc_nodes
                                             = h2 ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads h2 get_tag_name_new_element[rotated, OF new_element_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by(blast)+
  then have tag_name_eq2_h: "⋀ptr'. ptr' ≠ new_element_ptr
                                    ⟹ |h ⊢ get_tag_name ptr'|r = |h2 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force
  have "h2 ⊢ get_tag_name new_element_ptr →r ''''"
    using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
      new_element_is_element_ptr[OF new_element_ptr] new_element_empty_tag_name
    by blast


  have disconnected_nodes_eq_h:
    "⋀doc_ptr disc_nodes. h ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                             = h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads h2 get_disconnected_nodes_new_element[OF new_element_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have disconnected_nodes_eq2_h:
    "⋀doc_ptr. |h ⊢ get_disconnected_nodes doc_ptr|r = |h2 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force

  have children_eq_h2:
    "⋀ptr' children. h2 ⊢ get_child_nodes ptr' →r children = h3 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads set_tag_name_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_tag_name_get_child_nodes)
  then have children_eq2_h2: "⋀ptr'. |h2 ⊢ get_child_nodes ptr'|r = |h3 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h2:
    "⋀doc_ptr disc_nodes. h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                               = h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads set_tag_name_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_tag_name_get_disconnected_nodes)
  then have disconnected_nodes_eq2_h2:
    "⋀doc_ptr. |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h3 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h2:
    "⋀ptr' disc_nodes. ptr' ≠  new_element_ptr
              ⟹ h2 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h3 ⊢ get_tag_name ptr' →r disc_nodes"
    apply(rule reads_writes_preserved[OF get_tag_name_reads set_tag_name_writes h3])
    by (metis local.set_tag_name_get_tag_name_different_pointers)
  then have tag_name_eq2_h2: "⋀ptr'. ptr' ≠ new_element_ptr
                                    ⟹ |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force
  have "h2 ⊢ get_tag_name new_element_ptr →r ''''"
    using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
      new_element_is_element_ptr[OF new_element_ptr] new_element_empty_tag_name
    by blast

  have "type_wf h2"
    using ‹type_wf h› new_element_types_preserved h2 by blast
  then have "type_wf h3"
    using writes_small_big[where P="λh h'. type_wf h ⟶ 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="λh h'. type_wf h ⟶ 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:
    "⋀ptr' children. h3 ⊢ get_child_nodes ptr' →r children = h' ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_disconnected_nodes_get_child_nodes)
  then have children_eq2_h3: "⋀ptr'. |h3 ⊢ get_child_nodes ptr'|r = |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h3:
    "⋀doc_ptr disc_nodes. document_ptr ≠ doc_ptr
       ⟹ h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                               = h' ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
  then have disconnected_nodes_eq2_h3:
    "⋀doc_ptr. document_ptr ≠ doc_ptr
                ⟹ |h3 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h2:
    "⋀ptr' disc_nodes. ptr' ≠  new_element_ptr
              ⟹ h2 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h3 ⊢ get_tag_name ptr' →r disc_nodes"
    apply(rule reads_writes_preserved[OF get_tag_name_reads set_tag_name_writes h3])
    by (metis local.set_tag_name_get_tag_name_different_pointers)
  then have tag_name_eq2_h2: "⋀ptr'. ptr' ≠ new_element_ptr
                                    ⟹ |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have disc_nodes_document_ptr_h2: "h2 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3"
    using disconnected_nodes_eq_h2 disc_nodes_h3 by auto
  then have disc_nodes_document_ptr_h: "h ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3"
    using disconnected_nodes_eq_h by auto
  then have "cast new_element_ptr ∉ set disc_nodes_h3"
    using ‹heap_is_wellformed h›
    using ‹castelement_ptr2node_ptr new_element_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      a_all_ptrs_in_heap_def heap_is_wellformed_def
    using NodeMonad.ptr_kinds_ptr_kinds_M local.heap_is_wellformed_disc_nodes_in_heap by blast

  have tag_name_eq_h3:
    "⋀ptr' disc_nodes. h3 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h' ⊢ get_tag_name ptr' →r disc_nodes"
    apply(rule reads_writes_preserved[OF get_tag_name_reads set_disconnected_nodes_writes h'])
    using set_disconnected_nodes_get_tag_name
    by blast
  then have tag_name_eq2_h3: "⋀ptr'. |h3 ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
    using select_result_eq by force


  have "acyclic (parent_child_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
  also have "parent_child_rel h = parent_child_rel h2"
  proof(auto simp add: CD.parent_child_rel_def)[1]
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h2"
      by (simp add: object_ptr_kinds_eq_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "x ∈ set |h2 ⊢ get_child_nodes a|r"
      by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
          ‹castelement_ptr2object_ptr new_element_ptr ∉ set |h ⊢ object_ptr_kinds_M|r› children_eq2_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h"
      using object_ptr_kinds_eq_h ‹h2 ⊢ get_child_nodes (castelement_ptr2object_ptr new_element_ptr) →r []›
      by(auto)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "x ∈ set |h ⊢ get_child_nodes a|r"
      by (metis (no_types, lifting)
          ‹h2 ⊢ get_child_nodes (castelement_ptr2object_ptr new_element_ptr) →r []›
          children_eq2_h empty_iff empty_set image_eqI select_result_I2)
  qed
  also have "… = parent_child_rel h3"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
  also have "… = parent_child_rel h'"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
  finally have "CD.a_acyclic_heap h'"
    by (simp add: CD.acyclic_heap_def)

  have "CD.a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_all_ptrs_in_heap h2"
    apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
     apply (metis ‹known_ptrs h2› ‹parent_child_rel h = parent_child_rel h2› ‹type_wf h2› assms(1)
        assms(3) funion_iff CD.get_child_nodes_ok local.known_ptrs_known_ptr
        local.parent_child_rel_child_in_heap CD.parent_child_rel_child_nodes2 node_ptr_kinds_commutes
        node_ptr_kinds_eq_h returns_result_select_result)
    by (metis (no_types, opaque_lifting) CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
        ‹h2 ⊢ get_child_nodes (castelement_ptr2object_ptr new_element_ptr) →r []› assms(3) assms(4)
        children_eq_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h is_OK_returns_result_I
        local.known_ptrs_known_ptr node_ptr_kinds_commutes returns_result_select_result subsetD)
  then have "CD.a_all_ptrs_in_heap h3"
    by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
  then have "CD.a_all_ptrs_in_heap h'"
    by (smt (verit) children_eq2_h3 disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2
        disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 finsertCI funion_finsert_right
        h' insert_iff list.simps(15) local.CD.a_all_ptrs_in_heap_def
        local.set_disconnected_nodes_get_disconnected_nodes node_ptr_kinds_eq_h node_ptr_kinds_eq_h2
        node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3 select_result_I2 subsetD subsetI)
  have "⋀p. p |∈| object_ptr_kinds h ⟹ cast new_element_ptr ∉ set |h ⊢ get_child_nodes p|r"
    using ‹heap_is_wellformed h› ‹castelement_ptr2node_ptr new_element_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      heap_is_wellformed_children_in_heap
    by (meson NodeMonad.ptr_kinds_ptr_kinds_M CD.a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
        fset_of_list_elem CD.get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result)
  then have "⋀p. p |∈| object_ptr_kinds h2 ⟹ cast new_element_ptr ∉ set |h2 ⊢ get_child_nodes p|r"
    using children_eq2_h
    apply(auto simp add: object_ptr_kinds_eq_h)[1]
    using ‹h2 ⊢ get_child_nodes (castelement_ptr2object_ptr new_element_ptr) →r []› apply auto[1]
    by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
        ‹castelement_ptr2object_ptr new_element_ptr ∉ set |h ⊢ object_ptr_kinds_M|r›)
  then have "⋀p. p |∈| object_ptr_kinds h3 ⟹ cast new_element_ptr ∉ set |h3 ⊢ get_child_nodes p|r"
    using object_ptr_kinds_eq_h2 children_eq2_h2 by auto
  then have new_element_ptr_not_in_any_children:
    "⋀p. p |∈| object_ptr_kinds h' ⟹ cast new_element_ptr ∉ set |h' ⊢ get_child_nodes p|r"
    using object_ptr_kinds_eq_h3 children_eq2_h3 by auto

  have "CD.a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by (simp add: CD.heap_is_wellformed_def heap_is_wellformed_def)
  then have "CD.a_distinct_lists h2"
    using ‹h2 ⊢ get_child_nodes (cast new_element_ptr) →r []›
    apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
        disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
       apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert_remove)
      apply(case_tac "x=cast new_element_ptr")
       apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
      apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     apply (metis IntI assms(1) assms(3) assms(4) empty_iff  CD.get_child_nodes_ok
        local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result)
    apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
    by (metis ‹ CD.a_distinct_lists h› ‹type_wf h2› disconnected_nodes_eq_h document_ptr_kinds_eq_h
        CD.distinct_lists_no_parent  get_disconnected_nodes_ok returns_result_select_result)

  then have " CD.a_distinct_lists h3"
    by(auto simp add:  CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        children_eq2_h2 object_ptr_kinds_eq_h2)
  then have " CD.a_distinct_lists h'"
  proof(auto simp add:  CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
      object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3
      intro!: distinct_concat_map_I)[1]
    fix x
    assume "distinct (concat (map (λdocument_ptr. |h3 ⊢ get_disconnected_nodes document_ptr|r)
                                              (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
      and "x |∈| document_ptr_kinds h3"
    then show "distinct |h' ⊢ get_disconnected_nodes x|r"
      using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h'
        set_disconnected_nodes_get_disconnected_nodes
      by (metis (no_types, lifting) ‹castelement_ptr2node_ptr new_element_ptr ∉ set disc_nodes_h3›
          ‹ CD.a_distinct_lists h3› ‹type_wf h'› disc_nodes_h3 distinct.simps(2)
          CD.distinct_lists_disconnected_nodes  get_disconnected_nodes_ok returns_result_eq
          returns_result_select_result)
  next
    fix x y xa
    assume "distinct (concat (map (λdocument_ptr. |h3 ⊢ get_disconnected_nodes document_ptr|r)
                                            (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
      and "x |∈| document_ptr_kinds h3"
      and "y |∈| document_ptr_kinds h3"
      and "x ≠ y"
      and "xa ∈ set |h' ⊢ get_disconnected_nodes x|r"
      and "xa ∈ set |h' ⊢ get_disconnected_nodes y|r"
    moreover have "set |h3 ⊢ get_disconnected_nodes x|r ∩ set |h3 ⊢ get_disconnected_nodes y|r = {}"
      using calculation by(auto dest: distinct_concat_map_E(1))
    ultimately show "False"
      by (smt (verit) NodeMonad.ptr_kinds_ptr_kinds_M ‹castelement_ptr2node_ptr
          new_element_ptr ∉ set |h ⊢ node_ptr_kinds_M|r› ‹local.CD.a_all_ptrs_in_heap h›
          disc_nodes_document_ptr_h disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
          disconnected_nodes_eq2_h3 disjoint_iff document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 h'
          l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
          local.CD.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
          select_result_I2 set_ConsD subsetD)
  next
    fix x xa xb
    assume 2: "(⋃x∈fset (object_ptr_kinds h3). set |h' ⊢ get_child_nodes x|r)
                   ∩ (⋃x∈fset (document_ptr_kinds h3). set |h3 ⊢ get_disconnected_nodes x|r) = {}"
      and 3: "xa |∈| object_ptr_kinds h3"
      and 4: "x ∈ set |h' ⊢ get_child_nodes xa|r"
      and 5: "xb |∈| document_ptr_kinds h3"
      and 6: "x ∈ set |h' ⊢ get_disconnected_nodes xb|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"
          ‹⋀p. p |∈| object_ptr_kinds h3
                      ⟹ castelement_ptr2node_ptr new_element_ptr ∉ set |h3 ⊢ get_child_nodes p|r›
          ‹ CD.a_distinct_lists h3› children_eq2_h3 disc_nodes_h3 CD.distinct_lists_no_parent h'
          select_result_I2 set_ConsD  set_disconnected_nodes_get_disconnected_nodes)
      by (metis "3" "4" "5" "6" ‹ CD.a_distinct_lists h3› ‹type_wf h3› children_eq2_h3
          CD.distinct_lists_no_parent  get_disconnected_nodes_ok returns_result_select_result)
  qed

  have "CD.a_owner_document_valid h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h'"
    using disc_nodes_h3 ‹document_ptr |∈| document_ptr_kinds h›
    apply(auto simp add: CD.a_owner_document_valid_def)[1]
    apply(auto simp add:  object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )[1]
    apply(auto simp add: object_ptr_kinds_eq_h2)[1]
    apply(auto simp add:  document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )[1]
    apply(auto simp add: document_ptr_kinds_eq_h2)[1]
    apply(auto simp add:  node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )[1]
    apply(auto simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )[1]
     apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
        disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
        disconnected_nodes_eq2_h3)[1]
     apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
        local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
    apply(simp add: object_ptr_kinds_eq_h)
    by(metis (no_types, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M
        ‹castelement_ptr2node_ptr new_element_ptr ∉ set |h ⊢ node_ptr_kinds_M|r› children_eq2_h children_eq2_h2
        children_eq2_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
        document_ptr_kinds_eq_h h'
        l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
        list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
        node_ptr_kinds_commutes select_result_I2)

  have "CD.a_heap_is_wellformed h'"
    using ‹CD.a_acyclic_heap h'› ‹CD.a_all_ptrs_in_heap h'› ‹CD.a_distinct_lists h'›
      ‹CD.a_owner_document_valid h'›
    by(simp add: CD.a_heap_is_wellformed_def)





  have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h"
    using object_ptr_kinds_eq_h
    by(auto simp add: shadow_root_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: shadow_root_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: shadow_root_ptr_kinds_def)



  have shadow_root_eq_h: "⋀element_ptr shadow_root_opt. element_ptr ≠ new_element_ptr
              ⟹ h ⊢ get_shadow_root element_ptr →r shadow_root_opt =
h2 ⊢ get_shadow_root element_ptr →r shadow_root_opt"
  proof -
    fix element_ptr shadow_root_opt
    assume "element_ptr ≠ new_element_ptr "
    have "∀P ∈ get_shadow_root_locs element_ptr. P h h2"
      using get_shadow_root_new_element new_element_ptr h2
      using ‹element_ptr ≠ new_element_ptr› by blast
    then
    have "preserved (get_shadow_root element_ptr) h h2"
      using get_shadow_root_new_element[rotated, OF new_element_ptr h2]
      using get_shadow_root_reads
      by(simp add: reads_def)
    then show "h ⊢ get_shadow_root element_ptr →r shadow_root_opt =
h2 ⊢ get_shadow_root element_ptr →r shadow_root_opt"
      by (simp add: preserved_def)
  qed
  have shadow_root_none: "h2 ⊢ get_shadow_root (new_element_ptr) →r None"
    using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
      new_element_is_element_ptr[OF new_element_ptr] new_element_no_shadow_root
    by blast

  have shadow_root_eq_h2:
    "⋀ptr' children. h2 ⊢ get_shadow_root ptr' →r children = h3 ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_tag_name_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_tag_name_get_shadow_root)
  have shadow_root_eq_h3:
    "⋀ptr' children. h3 ⊢ get_shadow_root ptr' →r children = h' ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    using set_disconnected_nodes_get_shadow_root
    by(auto simp add: set_disconnected_nodes_get_shadow_root)


  have "a_all_ptrs_in_heap h"
    by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
  then have "a_all_ptrs_in_heap h2"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
    using returns_result_eq shadow_root_eq_h shadow_root_none by fastforce
  then have "a_all_ptrs_in_heap h3"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
    using shadow_root_eq_h2 by blast
  then have "a_all_ptrs_in_heap h'"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
    by (simp add: shadow_root_eq_h3)

  have "a_distinct_lists h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_distinct_lists h2"
    apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h)[1]
    apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
    apply(case_tac "x = new_element_ptr")
    using shadow_root_none apply auto[1]
    using shadow_root_eq_h
    by (smt (verit) Diff_empty Diff_insert0 ElementMonad.ptr_kinds_M_ptr_kinds
        ElementMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) h2 insort_split
        local.get_shadow_root_ok local.shadow_root_same_host new_element_ptr new_element_ptr_not_in_heap
        option.distinct(1) returns_result_select_result select_result_I2 shadow_root_none)
  then have "a_distinct_lists h3"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2 select_result_eq[OF shadow_root_eq_h2])
  then have "a_distinct_lists h'"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3 select_result_eq[OF shadow_root_eq_h3])


  have "a_shadow_root_valid h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_shadow_root_valid h2"
  proof (unfold a_shadow_root_valid_def; safe)
    fix shadow_root_ptr
    assume "∀shadow_root_ptr∈fset (shadow_root_ptr_kinds h). ∃host∈fset (element_ptr_kinds h).
|h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧ |h ⊢ get_shadow_root host|r = Some shadow_root_ptr"
    assume "shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h2)"

    obtain previous_host where
      "previous_host ∈ fset (element_ptr_kinds h)" and
      "|h ⊢ get_tag_name previous_host|r ∈ safe_shadow_root_element_types" and
      "|h ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr"
      by (metis ‹local.a_shadow_root_valid h› ‹shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h2)›
          local.a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h)
    moreover have "previous_host ≠ new_element_ptr"
      using calculation(1) h2 new_element_ptr new_element_ptr_not_in_heap by auto
    ultimately have "|h2 ⊢ get_tag_name previous_host|r ∈ safe_shadow_root_element_types" and
      "|h2 ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr"
      using shadow_root_eq_h
       apply (simp add: tag_name_eq2_h)
      by (metis ‹previous_host ≠ new_element_ptr›
          ‹|h ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr›
          select_result_eq shadow_root_eq_h)
    then
    show "∃host∈fset (element_ptr_kinds h2).
|h2 ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
|h2 ⊢ get_shadow_root host|r = Some shadow_root_ptr"
      by (meson ‹previous_host ∈ fset (element_ptr_kinds h)› ‹previous_host ≠ new_element_ptr›
          assms(3) local.get_shadow_root_ok local.get_shadow_root_ptr_in_heap
          returns_result_select_result shadow_root_eq_h)
  qed
  then have "a_shadow_root_valid h3"
  proof (unfold a_shadow_root_valid_def; safe)
    fix shadow_root_ptr
    assume "∀shadow_root_ptr∈fset (shadow_root_ptr_kinds h2). ∃host∈fset (element_ptr_kinds h2).
|h2 ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
|h2 ⊢ get_shadow_root host|r = Some shadow_root_ptr"
    assume "shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h3)"

    obtain previous_host where
      "previous_host ∈ fset (element_ptr_kinds h2)" and
      "|h2 ⊢ get_tag_name previous_host|r ∈ safe_shadow_root_element_types" and
      "|h2 ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr"
      by (metis ‹local.a_shadow_root_valid h2› ‹shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h3)›
          local.a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h2)
    moreover have "previous_host ≠ new_element_ptr"
      using calculation(1) h3 new_element_ptr new_element_ptr_not_in_heap
      using calculation(3) shadow_root_none by auto
    ultimately have "|h2 ⊢ get_tag_name previous_host|r ∈ safe_shadow_root_element_types" and
      "|h2 ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr"
      using shadow_root_eq_h2
       apply (simp add: tag_name_eq2_h2)
      by (metis ‹previous_host ≠ new_element_ptr›
          ‹|h2 ⊢ get_shadow_root previous_host|r = Some shadow_root_ptr› select_result_eq
          shadow_root_eq_h)
    then
    show "∃host∈fset (element_ptr_kinds h3).
|h3 ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
|h3 ⊢ get_shadow_root host|r = Some shadow_root_ptr"
      by (metis ‹previous_host ∈ fset (element_ptr_kinds h2)› ‹previous_host ≠ new_element_ptr›
          element_ptr_kinds_eq_h2 select_result_eq shadow_root_eq_h2 tag_name_eq2_h2)
  qed
  then have "a_shadow_root_valid h'"
    by (smt (verit) ‹type_wf h3› element_ptr_kinds_eq_h3 local.a_shadow_root_valid_def
        local.get_shadow_root_ok returns_result_select_result select_result_I2 shadow_root_eq_h3
        shadow_root_ptr_kinds_eq_h3 tag_name_eq2_h3)

  have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
    apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h shadow_root_eq_h)[1]
      apply (smt (verit, del_insts) assms(3) case_prodI h2 local.get_shadow_root_ok mem_Collect_eq
              new_element_ptr new_element_ptr_not_in_heap pair_imageI returns_result_select_result
              select_result_I2 shadow_root_eq_h)
    using shadow_root_none apply auto[1]
    by (metis (no_types, lifting) assms(3) h2 host_shadow_root_rel_def
        host_shadow_root_rel_shadow_root local.a_host_shadow_root_rel_def local.get_shadow_root_impl
        local.get_shadow_root_ok local.new_element_no_shadow_root new_element_ptr option.distinct(1)
        returns_result_select_result select_result_I2 shadow_root_eq_h)
  have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
    apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq_h2)[1]
     apply (metis (mono_tags, lifting) ‹type_wf h2› case_prodI local.get_shadow_root_ok
            mem_Collect_eq pair_imageI returns_result_select_result select_result_I2 shadow_root_eq_h2)
    apply (metis (mono_tags, lifting) case_prodI mem_Collect_eq pair_imageI select_result_eq shadow_root_eq_h2)
    done
  have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
    apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq_h2)[1]
     apply (metis (mono_tags, lifting) ‹type_wf h'› case_prodI element_ptr_kinds_eq_h2
             element_ptr_kinds_eq_h3 local.get_shadow_root_ok mem_Collect_eq pair_imageI
             returns_result_select_result select_result_I2 shadow_root_eq_h3)
    apply (metis (mono_tags, lifting) ‹type_wf h'› case_prodI element_ptr_kinds_eq_h2
            element_ptr_kinds_eq_h3 local.get_shadow_root_ok mem_Collect_eq pair_imageI
            returns_result_select_result select_result_I2 shadow_root_eq_h3)
    done
  have "acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def)
  have "parent_child_rel h ∪ a_host_shadow_root_rel h =
parent_child_rel h2 ∪ a_host_shadow_root_rel h2"
    using ‹local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2›
      ‹parent_child_rel h = parent_child_rel h2› by auto
  have "parent_child_rel h2 ∪ a_host_shadow_root_rel h2 =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    using ‹local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3›
      ‹parent_child_rel h2 = parent_child_rel h3› by auto
  have "parent_child_rel h' ∪ a_host_shadow_root_rel h' =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    by (simp add: ‹local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'›
        ‹parent_child_rel h3 = parent_child_rel h'›)

  have "acyclic (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)"
    using ‹acyclic (parent_child_rel h ∪ local.a_host_shadow_root_rel h)›
      ‹parent_child_rel h ∪ local.a_host_shadow_root_rel h =
parent_child_rel h2 ∪ local.a_host_shadow_root_rel h2›
      ‹parent_child_rel h2 ∪ local.a_host_shadow_root_rel h2 =
parent_child_rel h3 ∪ local.a_host_shadow_root_rel h3›
    by auto
  then have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
    by(simp add: ‹parent_child_rel h' ∪ a_host_shadow_root_rel h' =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3›)


  show " heap_is_wellformed h' "
    using ‹acyclic (parent_child_rel h' ∪ local.a_host_shadow_root_rel h')›
    by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl
        ‹local.CD.a_heap_is_wellformed h'› ‹local.a_all_ptrs_in_heap h'› ‹local.a_distinct_lists h'›
        ‹local.a_shadow_root_valid h'›)
qed
end

interpretation i_create_element_wf?: l_create_element_wfShadow_DOM known_ptr known_ptrs type_wf
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  heap_is_wellformed parent_child_rel set_tag_name set_tag_name_locs set_disconnected_nodes
  set_disconnected_nodes_locs create_element get_shadow_root get_shadow_root_locs get_tag_name
  get_tag_name_locs heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs DocumentClass.known_ptr DocumentClass.type_wf
  by(auto simp add: l_create_element_wfShadow_DOM_def instances)
declare l_create_element_wfCore_DOM_axioms [instances]


subsubsection ‹create\_character\_data›

locale l_create_character_data_wfShadow_DOM =
  l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
  l_heap_is_wellformedShadow_DOM get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs +
  l_create_character_dataShadow_DOM get_disconnected_nodes get_disconnected_nodes_locs
  set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs create_character_data
  known_ptr type_wfCore_DOM known_ptrCore_DOM
  + l_new_character_data_get_disconnected_nodes
  get_disconnected_nodes get_disconnected_nodes_locs

+ l_set_val_get_disconnected_nodes
type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs
+ l_new_character_data_get_child_nodes
type_wf known_ptr get_child_nodes get_child_nodes_locs
+ l_set_val_get_child_nodes
type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs
+ l_set_disconnected_nodes_get_child_nodes
set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs
+ l_set_disconnected_nodes
type_wf set_disconnected_nodes set_disconnected_nodes_locs
+ l_set_disconnected_nodes_get_disconnected_nodes
type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
set_disconnected_nodes_locs
+ l_set_val_get_shadow_root type_wf set_val set_val_locs get_shadow_root get_shadow_root_locs
+ l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes set_disconnected_nodes_locs
get_shadow_root get_shadow_root_locs
+ l_new_character_data_get_tag_name
get_tag_name get_tag_name_locs
+ l_set_val_get_tag_name type_wf set_val set_val_locs get_tag_name get_tag_name_locs
+ l_get_tag_name type_wf get_tag_name get_tag_name_locs
+ l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
get_tag_name get_tag_name_locs
+ l_new_character_data
type_wf
+ l_known_ptrs
known_ptr known_ptrs
for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
  and known_ptrs :: "(_) heap ⇒ bool"
  and type_wf :: "(_) heap ⇒ bool"
  and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
  and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
  and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and heap_is_wellformed :: "(_) heap ⇒ bool"
  and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
  and set_tag_name :: "(_) element_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
  and set_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
  and set_disconnected_nodes :: "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
  and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
  and create_element :: "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) element_ptr) prog"
  and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
  and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
  and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
  and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
  and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_disconnected_document :: "(_) node_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
  and get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
  and set_val :: "(_) character_data_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
  and set_val_locs :: "(_) character_data_ptr ⇒ ((_) heap, exception, unit) prog set"
  and create_character_data ::
  "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) character_data_ptr) prog"
  and known_ptrCore_DOM :: "(_::linorder) object_ptr ⇒ bool"
  and type_wfCore_DOM :: "(_) heap ⇒ bool"
begin
lemma create_character_data_preserves_wellformedness:
  assumes "heap_is_wellformed h"
    and "h ⊢ create_character_data document_ptr text →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 ⊢ new_character_data →r new_character_data_ptr" and
    h2: "h ⊢ new_character_data →h h2" and
    h3: "h2 ⊢ set_val new_character_data_ptr text →h h3" and
    disc_nodes_h3: "h3 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3" and
    h': "h3 ⊢ set_disconnected_nodes document_ptr (cast new_character_data_ptr # disc_nodes_h3) →h h'"
    using assms(2)
    by(auto simp add: CD.create_character_data_def
        elim!: bind_returns_heap_E
        bind_returns_heap_E2[rotated, OF CD.get_disconnected_nodes_pure, rotated] )
  then have "h ⊢ create_character_data document_ptr text →r new_character_data_ptr"
    apply(auto simp add: CD.create_character_data_def intro!: bind_returns_result_I)[1]
    apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
    apply (metis is_OK_returns_heap_E is_OK_returns_result_I local.CD.get_disconnected_nodes_pure
        pure_returns_heap_eq)
    by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)


  have "new_character_data_ptr ∉ set |h ⊢ character_data_ptr_kinds_M|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 ∉ set |h ⊢ node_ptr_kinds_M|r"
    by simp
  then have "cast new_character_data_ptr ∉ set |h ⊢ object_ptr_kinds_M|r"
    by simp



  have object_ptr_kinds_eq_h:
    "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|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 |∪| {|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 |∪| {|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="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF CD.set_val_writes h3])
    using CD.set_val_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λ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 ‹h ⊢ create_character_data document_ptr text →r new_character_data_ptr›
      local.create_character_data_known_ptr by blast
  then
  have "known_ptrs h2"
    using known_ptrs_new_ptr object_ptr_kinds_eq_h ‹known_ptrs h› 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 |∈| document_ptr_kinds h"
    using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
      CD.get_disconnected_nodes_ptr_in_heap ‹type_wf h› document_ptr_kinds_def
    by (metis is_OK_returns_result_I)

  have children_eq_h: "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_character_data_ptr
                  ⟹ h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h2
      get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h:
    "⋀ptr'. ptr' ≠ cast new_character_data_ptr
      ⟹ |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have object_ptr_kinds_eq_h:
    "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|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 |∪| {|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 |∪| {|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="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF CD.set_val_writes h3])
    using CD.set_val_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def)
  then have character_data_ptr_kinds_eq_h2: "character_data_ptr_kinds h3 = character_data_ptr_kinds h2"
    by(simp add: character_data_ptr_kinds_def)
  have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
    using node_ptr_kinds_eq_h2
    by(simp add: element_ptr_kinds_def)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_disconnected_nodes_writes h'])
    using set_disconnected_nodes_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: node_ptr_kinds_def)
  then have character_data_ptr_kinds_eq_h3: "character_data_ptr_kinds h' = character_data_ptr_kinds h3"
    by(simp add: character_data_ptr_kinds_def)
  have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
    using node_ptr_kinds_eq_h3
    by(simp add: element_ptr_kinds_def)


  have "document_ptr |∈| document_ptr_kinds h"
    using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
      CD.get_disconnected_nodes_ptr_in_heap ‹type_wf h› document_ptr_kinds_def
    by (metis is_OK_returns_result_I)

  have children_eq_h: "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_character_data_ptr
                ⟹ h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h2
      get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h: "⋀ptr'. ptr' ≠ cast new_character_data_ptr
                                 ⟹ |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force

  have "h2 ⊢ get_child_nodes (cast new_character_data_ptr) →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:
    "⋀doc_ptr disc_nodes. h ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                             = h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads h2
      get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have disconnected_nodes_eq2_h:
    "⋀doc_ptr. |h ⊢ get_disconnected_nodes doc_ptr|r = |h2 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h:
    "⋀ptr' disc_nodes. h ⊢ get_tag_name ptr' →r disc_nodes
                                             = h2 ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads h2
      get_tag_name_new_character_data[OF new_character_data_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have tag_name_eq2_h: "⋀ptr'. |h ⊢ get_tag_name ptr'|r = |h2 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have children_eq_h2:
    "⋀ptr' children. h2 ⊢ get_child_nodes ptr' →r children = h3 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads CD.set_val_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_val_get_child_nodes)
  then have children_eq2_h2:
    "⋀ptr'. |h2 ⊢ get_child_nodes ptr'|r = |h3 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h2:
    "⋀doc_ptr disc_nodes. h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                              = h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads CD.set_val_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_val_get_disconnected_nodes)
  then have disconnected_nodes_eq2_h2:
    "⋀doc_ptr. |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h3 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h2:
    "⋀ptr' disc_nodes. h2 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h3 ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads CD.set_val_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_val_get_tag_name)
  then have tag_name_eq2_h2: "⋀ptr'. |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have "type_wf h2"
    using ‹type_wf h› new_character_data_types_preserved h2 by blast
  then have "type_wf h3"
    using writes_small_big[where P="λh h'. type_wf h ⟶ type_wf h'", OF CD.set_val_writes h3]
    using  set_val_types_preserved
    by(auto simp add: reflp_def transp_def)
  then show "type_wf h'"
    using writes_small_big[where P="λh h'. type_wf h ⟶ 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:
    "⋀ptr' children. h3 ⊢ get_child_nodes ptr' →r children = h' ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_disconnected_nodes_get_child_nodes)
  then have children_eq2_h3:
    " ⋀ptr'. |h3 ⊢ get_child_nodes ptr'|r = |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h3: "⋀doc_ptr disc_nodes. document_ptr ≠ doc_ptr
    ⟹ h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                            = h' ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
  then have disconnected_nodes_eq2_h3: "⋀doc_ptr. document_ptr ≠ doc_ptr
             ⟹ |h3 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h3:
    "⋀ptr' disc_nodes. h3 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h' ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_disconnected_nodes_get_tag_name)
  then have tag_name_eq2_h3: "⋀ptr'. |h3 ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have disc_nodes_document_ptr_h2: "h2 ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3"
    using disconnected_nodes_eq_h2 disc_nodes_h3 by auto
  then have disc_nodes_document_ptr_h: "h ⊢ get_disconnected_nodes document_ptr →r disc_nodes_h3"
    using disconnected_nodes_eq_h by auto
  then have "cast new_character_data_ptr ∉ set disc_nodes_h3"
    using ‹heap_is_wellformed h› using ‹cast new_character_data_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      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 ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
  also have "parent_child_rel h = parent_child_rel h2"
  proof(auto simp add: CD.parent_child_rel_def)[1]
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h2"
      by (simp add: object_ptr_kinds_eq_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "x ∈ set |h2 ⊢ get_child_nodes a|r"
      by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
          ‹cast new_character_data_ptr ∉ set |h ⊢ object_ptr_kinds_M|r› children_eq2_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h"
      using object_ptr_kinds_eq_h ‹h2 ⊢ get_child_nodes (cast new_character_data_ptr) →r []›
      by(auto)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "x ∈ set |h ⊢ get_child_nodes a|r"
      by (metis (no_types, lifting) ‹h2 ⊢ get_child_nodes (cast new_character_data_ptr) →r []›
          children_eq2_h empty_iff empty_set image_eqI select_result_I2)
  qed
  also have "… = parent_child_rel h3"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
  also have "… = parent_child_rel h'"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
  finally have "CD.a_acyclic_heap h'"
    by (simp add: CD.acyclic_heap_def)

  have "CD.a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_all_ptrs_in_heap h2"
    apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
    using node_ptr_kinds_eq_h ‹cast new_character_data_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      ‹h2 ⊢ get_child_nodes (cast new_character_data_ptr) →r []›
    apply (metis (no_types, opaque_lifting) NodeMonad.ptr_kinds_ptr_kinds_M
        ‹parent_child_rel h = parent_child_rel h2›
        children_eq2_h finsert_iff funion_finsert_right CD.parent_child_rel_child
        CD.parent_child_rel_parent_in_heap node_ptr_kinds_commutes object_ptr_kinds_eq_h
        select_result_I2 subsetD sup_bot.right_neutral)
    by (metis (no_types, opaque_lifting) CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
        ‹h2 ⊢ get_child_nodes (castcharacter_data_ptr2object_ptr new_character_data_ptr) →r []› assms(3) assms(4)
        children_eq_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h
        is_OK_returns_result_I local.known_ptrs_known_ptr node_ptr_kinds_commutes
        returns_result_select_result subset_code(1))
  then have "CD.a_all_ptrs_in_heap h3"
    by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
  then have "CD.a_all_ptrs_in_heap h'"
    by (smt (verit) children_eq2_h3 disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2
        disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 finsertCI funion_finsert_right
        h' local.CD.a_all_ptrs_in_heap_def local.set_disconnected_nodes_get_disconnected_nodes
        node_ptr_kinds_eq_h node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3
        select_result_I2 set_ConsD subsetD subsetI)
  have "⋀p. p |∈| object_ptr_kinds h ⟹ cast new_character_data_ptr ∉ set |h ⊢ get_child_nodes p|r"
    using ‹heap_is_wellformed h› ‹cast new_character_data_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      heap_is_wellformed_children_in_heap
    by (meson NodeMonad.ptr_kinds_ptr_kinds_M CD.a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
        fset_of_list_elem CD.get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result)
  then have "⋀p. p |∈| object_ptr_kinds h2 ⟹
cast new_character_data_ptr ∉ set |h2 ⊢ get_child_nodes p|r"
    using children_eq2_h
    apply(auto simp add: object_ptr_kinds_eq_h)[1]
    using ‹h2 ⊢ get_child_nodes (cast new_character_data_ptr) →r []› apply auto[1]
    by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
        ‹cast new_character_data_ptr ∉ set |h ⊢ object_ptr_kinds_M|r›)
  then have "⋀p. p |∈| object_ptr_kinds h3 ⟹
cast new_character_data_ptr ∉ set |h3 ⊢ get_child_nodes p|r"
    using object_ptr_kinds_eq_h2 children_eq2_h2 by auto
  then have new_character_data_ptr_not_in_any_children:
    "⋀p. p |∈| object_ptr_kinds h' ⟹ cast new_character_data_ptr ∉ set |h' ⊢ get_child_nodes p|r"
    using object_ptr_kinds_eq_h3 children_eq2_h3 by auto

  have "CD.a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_distinct_lists h2"
    using ‹h2 ⊢ get_child_nodes (cast new_character_data_ptr) →r []›
    apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
        disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
    apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert_remove)
    apply(case_tac "x=cast new_character_data_ptr")
    apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
    apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
    apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
    apply (metis IntI assms(1) assms(3) assms(4) empty_iff CD.get_child_nodes_ok
        local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr
        returns_result_select_result)
    apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
    thm children_eq2_h

    using ‹CD.a_distinct_lists h› ‹type_wf h2› disconnected_nodes_eq_h document_ptr_kinds_eq_h
      CD.distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result
    by metis
  then have "CD.a_distinct_lists h3"
    by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        children_eq2_h2 object_ptr_kinds_eq_h2)[1]
  then have "CD.a_distinct_lists h'"
  proof(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
      object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1]
    fix x
    assume "distinct (concat (map (λdocument_ptr. |h3 ⊢ get_disconnected_nodes document_ptr|r)
                      (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
      and "x |∈| document_ptr_kinds h3"
    then show "distinct |h' ⊢ get_disconnected_nodes x|r"
      using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h'
        set_disconnected_nodes_get_disconnected_nodes
      by (metis (no_types, opaque_lifting)
          ‹castcharacter_data_ptr2node_ptr new_character_data_ptr ∉ set disc_nodes_h3› ‹type_wf h2› assms(1)
          disc_nodes_document_ptr_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
          disconnected_nodes_eq_h distinct.simps(2) document_ptr_kinds_eq_h2 local.get_disconnected_nodes_ok
          local.heap_is_wellformed_disconnected_nodes_distinct returns_result_select_result select_result_I2)
  next
    fix x y xa
    assume "distinct (concat (map (λdocument_ptr. |h3 ⊢ get_disconnected_nodes document_ptr|r)
                                            (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
      and "x |∈| document_ptr_kinds h3"
      and "y |∈| document_ptr_kinds h3"
      and "x ≠ y"
      and "xa ∈ set |h' ⊢ get_disconnected_nodes x|r"
      and "xa ∈ set |h' ⊢ get_disconnected_nodes y|r"
    moreover have "set |h3 ⊢ get_disconnected_nodes x|r ∩ set |h3 ⊢ get_disconnected_nodes y|r = {}"
      using calculation by(auto dest: distinct_concat_map_E(1))
    ultimately show "False"
      using  NodeMonad.ptr_kinds_ptr_kinds_M
        ‹castcharacter_data_ptr2node_ptr new_character_data_ptr ∉ set |h ⊢ node_ptr_kinds_M|r›
      by (smt (verit) ‹local.CD.a_all_ptrs_in_heap h› disc_nodes_document_ptr_h
          disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff
          document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 h'
          l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
          local.CD.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
          select_result_I2 set_ConsD subsetD)
  next
    fix x xa xb
    assume 2: "(⋃x∈fset (object_ptr_kinds h3). set |h' ⊢ get_child_nodes x|r)
                  ∩ (⋃x∈fset (document_ptr_kinds h3). set |h3 ⊢ get_disconnected_nodes x|r) = {}"
      and 3: "xa |∈| object_ptr_kinds h3"
      and 4: "x ∈ set |h' ⊢ get_child_nodes xa|r"
      and 5: "xb |∈| document_ptr_kinds h3"
      and 6: "x ∈ set |h' ⊢ get_disconnected_nodes xb|r"
    show "False"
      using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
      apply(cases "document_ptr = xb")
      apply (metis (no_types, lifting) "3" "4" "5" "6" CD.distinct_lists_no_parent
          ‹local.CD.a_distinct_lists h2› ‹type_wf h'› children_eq2_h2 children_eq2_h3
          disc_nodes_document_ptr_h2 document_ptr_kinds_eq_h3 h' local.get_disconnected_nodes_ok
          local.set_disconnected_nodes_get_disconnected_nodes new_character_data_ptr_not_in_any_children
          object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 returns_result_eq returns_result_select_result
          set_ConsD)
      by (metis "3" "4" "5" "6" CD.distinct_lists_no_parent ‹local.CD.a_distinct_lists h3›
          ‹type_wf h3› children_eq2_h3 local.get_disconnected_nodes_ok returns_result_select_result)
  qed

  have "CD.a_owner_document_valid h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h'"
    using disc_nodes_h3 ‹document_ptr |∈| document_ptr_kinds h›
    apply(simp add: CD.a_owner_document_valid_def)
    apply(simp add: object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )
    apply(simp add: object_ptr_kinds_eq_h2)
    apply(simp add: document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )
    apply(simp add: document_ptr_kinds_eq_h2)
    apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )
    apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )
    apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
        disconnected_nodes_eq2_h
        disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1]
    apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
        local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
    apply(simp add: object_ptr_kinds_eq_h)
    by (metis (mono_tags, lifting)
        ‹castcharacter_data_ptr2object_ptr new_character_data_ptr ∉ set |h ⊢ object_ptr_kinds_M|r›
        children_eq2_h disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h h'
        l_ptr_kinds_M.ptr_kinds_ptr_kinds_M
        l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
        list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
        object_ptr_kinds_M_def
        select_result_I2)






  have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h"
    using object_ptr_kinds_eq_h
    by(auto simp add: shadow_root_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: shadow_root_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: shadow_root_ptr_kinds_def)



  have shadow_root_eq_h:
    "⋀character_data_ptr shadow_root_opt. h ⊢ get_shadow_root character_data_ptr →r shadow_root_opt =
h2 ⊢ get_shadow_root character_data_ptr →r shadow_root_opt"
    using get_shadow_root_reads h2 get_shadow_root_new_character_data[rotated, OF h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    using local.get_shadow_root_locs_impl new_character_data_ptr apply blast
    using local.get_shadow_root_locs_impl new_character_data_ptr by blast


  have shadow_root_eq_h2:
    "⋀ptr' children. h2 ⊢ get_shadow_root ptr' →r children = h3 ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_val_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_val_get_shadow_root)
  have shadow_root_eq_h3:
    "⋀ptr' children. h3 ⊢ get_shadow_root ptr' →r children = h' ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_disconnected_nodes_writes h'
    apply(rule reads_writes_preserved)
    using set_disconnected_nodes_get_shadow_root
    by(auto simp add: set_disconnected_nodes_get_shadow_root)


  have "a_all_ptrs_in_heap h"
    by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
  then have "a_all_ptrs_in_heap h2"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
    using returns_result_eq shadow_root_eq_h by fastforce
  then have "a_all_ptrs_in_heap h3"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
    using shadow_root_eq_h2 by blast
  then have "a_all_ptrs_in_heap h'"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
    by (simp add: shadow_root_eq_h3)

  have "a_distinct_lists h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_distinct_lists h2"
    apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
    apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
    by (metis ‹type_wf h2› assms(1) assms(3) local.get_shadow_root_ok local.shadow_root_same_host
        returns_result_select_result shadow_root_eq_h)
  then have "a_distinct_lists h3"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2
        select_result_eq[OF shadow_root_eq_h2])
  then have "a_distinct_lists h'"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3
        select_result_eq[OF shadow_root_eq_h3])


  have "a_shadow_root_valid h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_shadow_root_valid h2"
    by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h element_ptr_kinds_eq_h
        select_result_eq[OF shadow_root_eq_h] tag_name_eq2_h)
  then have "a_shadow_root_valid h3"
    by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h2 element_ptr_kinds_eq_h2
        select_result_eq[OF shadow_root_eq_h2] tag_name_eq2_h2)
  then have "a_shadow_root_valid h'"
    by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h3 element_ptr_kinds_eq_h3
        select_result_eq[OF shadow_root_eq_h3] tag_name_eq2_h3)



  have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
        select_result_eq[OF shadow_root_eq_h])
  have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2
        select_result_eq[OF shadow_root_eq_h2])
  have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3
        select_result_eq[OF shadow_root_eq_h3])

  have "acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def)
  have "parent_child_rel h ∪ a_host_shadow_root_rel h =
parent_child_rel h2 ∪ a_host_shadow_root_rel h2"
    using ‹local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2›
      ‹parent_child_rel h = parent_child_rel h2› by auto
  have "parent_child_rel h2 ∪ a_host_shadow_root_rel h2 =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    using ‹local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3›
      ‹parent_child_rel h2 = parent_child_rel h3› by auto
  have "parent_child_rel h' ∪ a_host_shadow_root_rel h' =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    by (simp add: ‹local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'›
        ‹parent_child_rel h3 = parent_child_rel h'›)

  have "acyclic (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)"
    using ‹acyclic (parent_child_rel h ∪ local.a_host_shadow_root_rel h)›
      ‹parent_child_rel h ∪ local.a_host_shadow_root_rel h = parent_child_rel h2 ∪
local.a_host_shadow_root_rel h2› ‹parent_child_rel h2 ∪ local.a_host_shadow_root_rel h2 =
parent_child_rel h3 ∪ local.a_host_shadow_root_rel h3› by auto
  then have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
    by(simp add: ‹parent_child_rel h' ∪ a_host_shadow_root_rel h' =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3›)


  have "CD.a_heap_is_wellformed h'"
    apply(simp add: CD.a_heap_is_wellformed_def)
    by (simp add: ‹local.CD.a_acyclic_heap h'› ‹local.CD.a_all_ptrs_in_heap h'›
        ‹local.CD.a_distinct_lists h'› ‹local.CD.a_owner_document_valid h'›)

  show "heap_is_wellformed h' "
    using ‹acyclic (parent_child_rel h' ∪ local.a_host_shadow_root_rel h')›
    by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl
        ‹local.CD.a_heap_is_wellformed h'› ‹local.a_all_ptrs_in_heap h'› ‹local.a_distinct_lists h'›
        ‹local.a_shadow_root_valid h'›)
qed
end

subsubsection ‹create\_document›

locale l_create_document_wfShadow_DOM =
  l_heap_is_wellformedShadow_DOM get_child_nodes get_child_nodes_locs get_disconnected_nodes
  get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs
  + l_new_document_get_disconnected_nodes
  get_disconnected_nodes get_disconnected_nodes_locs
  + l_create_documentCore_DOM
  create_document
  + l_new_document_get_child_nodes
  type_wf known_ptr get_child_nodes get_child_nodes_locs
  + l_get_tag_name type_wf get_tag_name get_tag_name_locs
  + l_new_document_get_tag_name get_tag_name get_tag_name_locs
  + l_get_disconnected_nodesShadow_DOM type_wf type_wfCore_DOM get_disconnected_nodes
  get_disconnected_nodes_locs
  + l_new_document
  type_wf
  + l_known_ptrs
  known_ptr known_ptrs
  for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
    and type_wf :: "(_) heap ⇒ bool"
    and type_wfCore_DOM :: "(_) heap ⇒ bool"
    and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
    and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
    and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
    and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
    and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
    and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and get_disconnected_document :: "(_) node_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
    and get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
    and heap_is_wellformed :: "(_) heap ⇒ bool"
    and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
    and set_val :: "(_) character_data_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
    and set_val_locs :: "(_) character_data_ptr ⇒ ((_) heap, exception, unit) prog set"
    and set_disconnected_nodes ::
    "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
    and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
    and create_document :: "((_) heap, exception, (_) document_ptr) prog"
    and known_ptrs :: "(_) heap ⇒ bool"
begin

lemma create_document_preserves_wellformedness:
  assumes "heap_is_wellformed h"
    and "h ⊢ create_document →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 ⊢ new_document →r new_document_ptr" and
    h': "h ⊢ new_document →h h'"
    using assms(2)
    apply(simp add: create_document_def)
    using new_document_ok by blast

  have "new_document_ptr ∉ set |h ⊢ document_ptr_kinds_M|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 ∉ set |h ⊢ object_ptr_kinds_M|r"
    by simp

  have "new_document_ptr |∉| 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 |∉| object_ptr_kinds h"
    by simp

  have object_ptr_kinds_eq: "object_ptr_kinds h' = object_ptr_kinds h |∪| {|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 |∪| {|new_document_ptr|}"
    using object_ptr_kinds_eq
    by (auto simp add: document_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h"
    using object_ptr_kinds_eq
    apply(simp add: shadow_root_ptr_kinds_def)
    by force


  have children_eq:
    "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_document_ptr
             ⟹ h ⊢ get_child_nodes ptr' →r children = h' ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h' get_child_nodes_new_document[rotated, OF new_document_ptr h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2: "⋀ptr'. ptr' ≠ cast new_document_ptr
                                    ⟹ |h ⊢ get_child_nodes ptr'|r = |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force


  have "h' ⊢ get_child_nodes (cast new_document_ptr) →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:
    "⋀doc_ptr disc_nodes. doc_ptr ≠ new_document_ptr
    ⟹ h ⊢ get_disconnected_nodes doc_ptr →r disc_nodes =
h' ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using CD.get_disconnected_nodes_reads h' get_disconnected_nodes_new_document_different_pointers
      new_document_ptr
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by (metis(full_types) ‹⋀thesis. (⋀new_document_ptr.
             ⟦h ⊢ new_document →r new_document_ptr; h ⊢ new_document →h h'⟧ ⟹ thesis) ⟹ thesis›
        local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+
  then have disconnected_nodes_eq2_h: "⋀doc_ptr. doc_ptr ≠ new_document_ptr
                 ⟹ |h ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have "h' ⊢ get_disconnected_nodes new_document_ptr →r []"
    using h' local.new_document_no_disconnected_nodes new_document_ptr by blast

  have "type_wf h'"
    using ‹type_wf h› new_document_types_preserved h' by blast

  have "acyclic (parent_child_rel h)"
    using ‹heap_is_wellformed h›
    by (auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
  also have "parent_child_rel h = parent_child_rel h'"
  proof(auto simp add: CD.parent_child_rel_def)[1]
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h'"
      by (simp add: object_ptr_kinds_eq)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "x ∈ set |h' ⊢ get_child_nodes a|r"
      by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
          ‹cast new_document_ptr ∉ set |h ⊢ object_ptr_kinds_M|r› children_eq2)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h'"
      and 1: "x ∈ set |h' ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h"
      using object_ptr_kinds_eq ‹h' ⊢ get_child_nodes (cast new_document_ptr) →r []›
      by(auto)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h'"
      and 1: "x ∈ set |h' ⊢ get_child_nodes a|r"
    then show "x ∈ set |h ⊢ get_child_nodes a|r"
      by (metis (no_types, lifting) ‹h' ⊢ get_child_nodes (cast new_document_ptr) →r []›
          children_eq2 empty_iff empty_set image_eqI select_result_I2)
  qed
  finally have "CD.a_acyclic_heap h'"
    by (simp add: CD.acyclic_heap_def)

  have "CD.a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def )
  then have "CD.a_all_ptrs_in_heap h'"
    apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
    using  ObjectMonad.ptr_kinds_ptr_kinds_M
      ‹castdocument_ptr2object_ptr new_document_ptr ∉ set |h ⊢ object_ptr_kinds_M|r›
      ‹parent_child_rel h = parent_child_rel h'› assms(1) children_eq fset_of_list_elem
      local.heap_is_wellformed_children_in_heap CD.parent_child_rel_child
      CD.parent_child_rel_parent_in_heap node_ptr_kinds_eq
    apply (metis (no_types, opaque_lifting)
        ‹h' ⊢ get_child_nodes (castdocument_ptr2object_ptr new_document_ptr) →r []›
        children_eq2 finsert_iff funion_finsert_right object_ptr_kinds_eq
        select_result_I2 subsetD sup_bot.right_neutral)
    by (metis (no_types, lifting) ‹h' ⊢ get_disconnected_nodes new_document_ptr →r []› ‹type_wf h'›
        assms(1) disconnected_nodes_eq_h empty_iff empty_set local.get_disconnected_nodes_ok
        local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq returns_result_select_result
        select_result_I2)

  have "CD.a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_distinct_lists h'"
    using ‹h' ⊢ get_disconnected_nodes new_document_ptr →r []›
      ‹h' ⊢ get_child_nodes (cast new_document_ptr) →r []›

    apply(auto simp add: children_eq2[symmetric] CD.a_distinct_lists_def insort_split
        object_ptr_kinds_eq
        document_ptr_kinds_eq_h  disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
    apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert_remove)

    apply(auto simp add:  dest: distinct_concat_map_E)[1]
    apply(auto simp add:  dest: distinct_concat_map_E)[1]
    using ‹new_document_ptr |∉| document_ptr_kinds h›
    apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1]
    apply (metis assms(1) assms(3) disconnected_nodes_eq2_h get_disconnected_nodes_ok
        local.heap_is_wellformed_disconnected_nodes_distinct
        returns_result_select_result)
  proof -
    fix x :: "(_) document_ptr" and y :: "(_) document_ptr" and xa :: "(_) node_ptr"
    assume a1: "x ≠ y"
    assume a2: "x |∈| document_ptr_kinds h"
    assume a3: "x ≠ new_document_ptr"
    assume a4: "y |∈| document_ptr_kinds h"
    assume a5: "y ≠ new_document_ptr"
    assume a6: "distinct (concat (map (λdocument_ptr. |h ⊢ get_disconnected_nodes document_ptr|r)
                                              (sorted_list_of_set (fset (document_ptr_kinds h)))))"
    assume a7: "xa ∈ set |h' ⊢ get_disconnected_nodes x|r"
    assume a8: "xa ∈ set |h' ⊢ get_disconnected_nodes y|r"
    have f9: "xa ∈ set |h ⊢ get_disconnected_nodes x|r"
      using a7 a3 disconnected_nodes_eq2_h by presburger
    have f10: "xa ∈ set |h ⊢ get_disconnected_nodes y|r"
      using a8 a5 disconnected_nodes_eq2_h by presburger
    have f11: "y ∈ set (sorted_list_of_set (fset (document_ptr_kinds h)))"
      using a4 by simp
    have "x ∈ 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' ⊢ get_disconnected_nodes new_document_ptr →r []"
      and 1: "h' ⊢ get_child_nodes (castdocument_ptr2object_ptr new_document_ptr) →r []"
      and 2: "distinct (concat (map (λptr. |h ⊢ get_child_nodes ptr|r)
                                                  (sorted_list_of_set (fset (object_ptr_kinds h)))))"
      and 3: "distinct (concat (map (λdocument_ptr. |h ⊢ get_disconnected_nodes document_ptr|r)
                                              (sorted_list_of_set (fset (document_ptr_kinds h)))))"
      and 4: "(⋃x∈fset (object_ptr_kinds h). set |h ⊢ get_child_nodes x|r)
                      ∩ (⋃x∈fset (document_ptr_kinds h). set |h ⊢ get_disconnected_nodes x|r) = {}"
      and 5: "x ∈ set |h ⊢ get_child_nodes xa|r"
      and 6: "x ∈ set |h' ⊢ get_disconnected_nodes xb|r"
      and 7: "xa |∈| object_ptr_kinds h"
      and 8: "xa ≠ castdocument_ptr2object_ptr new_document_ptr"
      and 9: "xb |∈| document_ptr_kinds h"
      and 10: "xb ≠ new_document_ptr"
    then show "False"

      by (metis ‹CD.a_distinct_lists h› assms(3) disconnected_nodes_eq2_h
          CD.distinct_lists_no_parent get_disconnected_nodes_ok
          returns_result_select_result)
  qed

  have "CD.a_owner_document_valid h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h'"
    apply(auto simp add: CD.a_owner_document_valid_def)[1]
    by (metis ‹castdocument_ptr2object_ptr new_document_ptr |∉| object_ptr_kinds h›
        children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes funion_iff
        node_ptr_kinds_eq object_ptr_kinds_eq)


  have shadow_root_eq_h: "⋀character_data_ptr shadow_root_opt.
h ⊢ get_shadow_root character_data_ptr →r shadow_root_opt =
h' ⊢ get_shadow_root character_data_ptr →r shadow_root_opt"
    using get_shadow_root_reads assms(2) get_shadow_root_new_document[rotated, OF h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    using local.get_shadow_root_locs_impl new_document_ptr apply blast
    using local.get_shadow_root_locs_impl new_document_ptr by blast


  have "a_all_ptrs_in_heap h"
    by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
  then have "a_all_ptrs_in_heap h'"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq document_ptr_kinds_eq_h)[1]
    using shadow_root_eq_h by fastforce

  have "a_distinct_lists h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_distinct_lists h'"
    apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
    apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
    by (metis ‹type_wf h'› assms(1) assms(3) local.get_shadow_root_ok local.shadow_root_same_host
        returns_result_select_result shadow_root_eq_h)


  have tag_name_eq_h:
    "⋀ptr' disc_nodes. h ⊢ get_tag_name ptr' →r disc_nodes
                                             = h' ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads h'
      get_tag_name_new_document[OF new_document_ptr h']
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+

  have "a_shadow_root_valid h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_shadow_root_valid h'"
    using new_document_is_document_ptr[OF new_document_ptr]
    by(auto simp add: a_shadow_root_valid_def element_ptr_kinds_eq_h document_ptr_kinds_eq_h
        shadow_root_ptr_kinds_eq select_result_eq[OF shadow_root_eq_h] select_result_eq[OF tag_name_eq_h])


  have "a_host_shadow_root_rel h = a_host_shadow_root_rel h'"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
        select_result_eq[OF shadow_root_eq_h])

  have "acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def)
  moreover
  have "parent_child_rel h ∪ a_host_shadow_root_rel h =
parent_child_rel h' ∪ a_host_shadow_root_rel h'"
    by (simp add: ‹local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h'›
        ‹parent_child_rel h = parent_child_rel h'›)
  ultimately have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
    by simp

  have "CD.a_heap_is_wellformed h'"
    apply(simp add: CD.a_heap_is_wellformed_def)
    by (simp add: ‹local.CD.a_acyclic_heap h'› ‹local.CD.a_all_ptrs_in_heap h'›
        ‹local.CD.a_distinct_lists h'› ‹local.CD.a_owner_document_valid h'›)

  show "heap_is_wellformed h'"
    using CD.heap_is_wellformed_impl ‹acyclic (parent_child_rel h' ∪ local.a_host_shadow_root_rel h')›
      ‹local.CD.a_heap_is_wellformed h'› ‹local.a_all_ptrs_in_heap h'› ‹local.a_distinct_lists h'›
      ‹local.a_shadow_root_valid h'› local.heap_is_wellformed_def by auto
qed
end

interpretation l_create_document_wfShadow_DOM known_ptr type_wf DocumentClass.type_wf get_child_nodes
  get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root
  get_shadow_root_locs get_tag_name get_tag_name_locs
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs heap_is_wellformed parent_child_rel set_val set_val_locs
  set_disconnected_nodes set_disconnected_nodes_locs create_document known_ptrs
  by(auto simp add: l_create_document_wfShadow_DOM_def instances)


subsubsection ‹attach\_shadow\_root›

locale l_attach_shadow_root_wfShadow_DOM =
  l_get_disconnected_nodes
  type_wf get_disconnected_nodes get_disconnected_nodes_locs
  + l_heap_is_wellformedShadow_DOM
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
  heap_is_wellformed parent_child_rel
  heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs
  + l_attach_shadow_rootShadow_DOM known_ptr set_shadow_root set_shadow_root_locs set_mode
  set_mode_locs attach_shadow_root type_wf get_tag_name get_tag_name_locs get_shadow_root
  get_shadow_root_locs
  + l_new_shadow_root_get_disconnected_nodes
  get_disconnected_nodes get_disconnected_nodes_locs

+ l_set_mode_get_disconnected_nodes
type_wf set_mode set_mode_locs get_disconnected_nodes get_disconnected_nodes_locs
+ l_new_shadow_root_get_child_nodes
type_wf known_ptr get_child_nodes get_child_nodes_locs
+ l_new_shadow_root_get_tag_name
type_wf get_tag_name get_tag_name_locs
+ l_set_mode_get_child_nodes
type_wf set_mode set_mode_locs known_ptr get_child_nodes get_child_nodes_locs
+ l_set_shadow_root_get_child_nodes
type_wf set_shadow_root set_shadow_root_locs known_ptr get_child_nodes get_child_nodes_locs
+ l_set_shadow_root
type_wf set_shadow_root set_shadow_root_locs
+ l_set_shadow_root_get_disconnected_nodes
set_shadow_root set_shadow_root_locs get_disconnected_nodes get_disconnected_nodes_locs
+ l_set_mode_get_shadow_root type_wf set_mode set_mode_locs get_shadow_root get_shadow_root_locs
+ l_set_shadow_root_get_shadow_root type_wf set_shadow_root set_shadow_root_locs
get_shadow_root get_shadow_root_locs
+ l_new_character_data_get_tag_name
get_tag_name get_tag_name_locs
+ l_set_mode_get_tag_name type_wf set_mode set_mode_locs get_tag_name get_tag_name_locs
+ l_get_tag_name type_wf get_tag_name get_tag_name_locs
+ l_set_shadow_root_get_tag_name set_shadow_root set_shadow_root_locs get_tag_name get_tag_name_locs
+ l_new_shadow_root
type_wf
+ l_known_ptrs
known_ptr known_ptrs
for known_ptr :: "(_::linorder) object_ptr ⇒ bool"
  and known_ptrs :: "(_) heap ⇒ bool"
  and type_wf :: "(_) heap ⇒ bool"
  and get_child_nodes :: "(_) object_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
  and get_child_nodes_locs :: "(_) object_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_disconnected_nodes :: "(_) document_ptr ⇒ ((_) heap, exception, (_) node_ptr list) prog"
  and get_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and heap_is_wellformed :: "(_) heap ⇒ bool"
  and parent_child_rel :: "(_) heap ⇒ ((_) object_ptr × (_) object_ptr) set"
  and set_tag_name :: "(_) element_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
  and set_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap, exception, unit) prog set"
  and set_disconnected_nodes :: "(_) document_ptr ⇒ (_) node_ptr list ⇒ ((_) heap, exception, unit) prog"
  and set_disconnected_nodes_locs :: "(_) document_ptr ⇒ ((_) heap, exception, unit) prog set"
  and create_element :: "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) element_ptr) prog"
  and get_shadow_root :: "(_) element_ptr ⇒ ((_) heap, exception, (_) shadow_root_ptr option) prog"
  and get_shadow_root_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_tag_name :: "(_) element_ptr ⇒ ((_) heap, exception, char list) prog"
  and get_tag_name_locs :: "(_) element_ptr ⇒ ((_) heap ⇒ (_) heap ⇒ bool) set"
  and heap_is_wellformedCore_DOM :: "(_) heap ⇒ bool"
  and get_host :: "(_) shadow_root_ptr ⇒ ((_) heap, exception, (_) element_ptr) prog"
  and get_host_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
  and get_disconnected_document :: "(_) node_ptr ⇒ ((_) heap, exception, (_) document_ptr) prog"
  and get_disconnected_document_locs :: "((_) heap ⇒ (_) heap ⇒ bool) set"
  and set_val :: "(_) character_data_ptr ⇒ char list ⇒ ((_) heap, exception, unit) prog"
  and set_val_locs :: "(_) character_data_ptr ⇒ ((_) heap, exception, unit) prog set"
  and create_character_data ::
  "(_) document_ptr ⇒ char list ⇒ ((_) heap, exception, (_) character_data_ptr) prog"
  and known_ptrCore_DOM :: "(_::linorder) object_ptr ⇒ bool"
  and type_wfCore_DOM :: "(_) heap ⇒ bool"
  and set_shadow_root :: "(_) element_ptr ⇒ (_) shadow_root_ptr option ⇒ (_, unit) dom_prog"
  and set_shadow_root_locs :: "(_) element_ptr ⇒ (_, unit) dom_prog set"
  and set_mode :: "(_) shadow_root_ptr ⇒ shadow_root_mode ⇒ (_, unit) dom_prog"
  and set_mode_locs :: "(_) shadow_root_ptr ⇒ (_, unit) dom_prog set"
  and attach_shadow_root :: "(_) element_ptr ⇒ shadow_root_mode ⇒ (_, (_) shadow_root_ptr) dom_prog"
begin
lemma attach_shadow_root_child_preserves:
  assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
  assumes "h ⊢ attach_shadow_root element_ptr new_mode →h h'"
  shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
proof -
  obtain h2 h3 new_shadow_root_ptr element_tag_name where
    element_tag_name: "h ⊢ get_tag_name element_ptr →r element_tag_name" and
    "element_tag_name ∈ safe_shadow_root_element_types" and
    prev_shadow_root: "h ⊢ get_shadow_root element_ptr →r None" and
    h2: "h ⊢ newShadowRoot_M →h h2" and
    new_shadow_root_ptr: "h ⊢ newShadowRoot_M →r new_shadow_root_ptr" and
    h3: "h2 ⊢ set_mode new_shadow_root_ptr new_mode →h h3" and
    h': "h3 ⊢ set_shadow_root element_ptr (Some new_shadow_root_ptr) →h h'"
    using assms(4)
    by(auto simp add: attach_shadow_root_def elim!: bind_returns_heap_E
        bind_returns_heap_E2[rotated, OF get_tag_name_pure, rotated]
        bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated] split: if_splits)

  have "h ⊢ attach_shadow_root element_ptr new_mode →r new_shadow_root_ptr"
    thm  bind_pure_returns_result_I[OF get_tag_name_pure]
    apply(unfold attach_shadow_root_def)[1]
    using element_tag_name
    apply(rule bind_pure_returns_result_I[OF get_tag_name_pure])
    apply(rule bind_pure_returns_result_I)
    using ‹element_tag_name ∈ safe_shadow_root_element_types› apply(simp)
    using ‹element_tag_name ∈ safe_shadow_root_element_types› apply(simp)
    using prev_shadow_root
    apply(rule bind_pure_returns_result_I[OF get_shadow_root_pure])
    apply(rule bind_pure_returns_result_I)
    apply(simp)
    apply(simp)
    using h2 new_shadow_root_ptr h3 h'
    by(auto intro!: bind_returns_result_I
        intro: is_OK_returns_result_E[OF is_OK_returns_heap_I[OF h3]]
        is_OK_returns_result_E[OF is_OK_returns_heap_I[OF h']])

  have "new_shadow_root_ptr ∉ set |h ⊢ shadow_root_ptr_kinds_M|r"
    using new_shadow_root_ptr ShadowRootMonad.ptr_kinds_ptr_kinds_M h2
    using newShadowRoot_M_ptr_not_in_heap by blast
  then have "cast new_shadow_root_ptr ∉ set |h ⊢ object_ptr_kinds_M|r"
    by simp



  have object_ptr_kinds_eq_h:
    "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|cast new_shadow_root_ptr|}"
    using newShadowRoot_M_new_ptr h2 new_shadow_root_ptr by blast
  then have document_ptr_kinds_eq_h:
    "document_ptr_kinds h2 = document_ptr_kinds h"
    apply(simp add: document_ptr_kinds_def)
    by force
  have shadow_root_ptr_kinds_eq_h:
    "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h |∪| {|new_shadow_root_ptr|}"
    using object_ptr_kinds_eq_h
    apply(simp add: shadow_root_ptr_kinds_def)
    by force
  have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
    using object_ptr_kinds_eq_h
    by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)

  have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_mode_writes h3])
    using set_mode_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
    by (auto simp add: document_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by (auto simp add: shadow_root_ptr_kinds_def)
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_shadow_root_writes h'])
    using set_shadow_root_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
    by (auto simp add: document_ptr_kinds_def)
  have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by (auto simp add: shadow_root_ptr_kinds_def)
  have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: node_ptr_kinds_def)

  have "known_ptr (cast new_shadow_root_ptr)"
    using ‹h ⊢ attach_shadow_root element_ptr new_mode →r new_shadow_root_ptr›
      create_shadow_root_known_ptr by blast
  then
  have "known_ptrs h2"
    using known_ptrs_new_ptr object_ptr_kinds_eq_h ‹known_ptrs h› h2
    by blast
  then
  have "known_ptrs h3"
    using known_ptrs_preserved object_ptr_kinds_eq_h2 by blast
  then
  show "known_ptrs h'"
    using known_ptrs_preserved object_ptr_kinds_eq_h3 by blast

  have "element_ptr |∈| element_ptr_kinds h"
    by (meson ‹h ⊢ attach_shadow_root element_ptr new_mode →r new_shadow_root_ptr›
        is_OK_returns_result_I local.attach_shadow_root_element_ptr_in_heap)


  have children_eq_h: "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_shadow_root_ptr
                  ⟹ h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h2 get_child_nodes_new_shadow_root[rotated, OF new_shadow_root_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h:
    "⋀ptr'. ptr' ≠ cast new_shadow_root_ptr
      ⟹ |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have object_ptr_kinds_eq_h:
    "object_ptr_kinds h2 = object_ptr_kinds h |∪| {|cast new_shadow_root_ptr|}"
    using newShadowRoot_new_ptr h2 new_shadow_root_ptr object_ptr_kinds_eq_h by blast
  then have node_ptr_kinds_eq_h:
    "node_ptr_kinds h2 = node_ptr_kinds h"
    apply(simp add: node_ptr_kinds_def)
    by force
  then have character_data_ptr_kinds_eq_h:
    "character_data_ptr_kinds h2 = character_data_ptr_kinds h"
    apply(simp add: character_data_ptr_kinds_def)
    done
  have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
    using object_ptr_kinds_eq_h
    by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)

  have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_mode_writes h3])
    using set_mode_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
    using object_ptr_kinds_eq_h2
    by(auto simp add: node_ptr_kinds_def)
  then have character_data_ptr_kinds_eq_h2: "character_data_ptr_kinds h3 = character_data_ptr_kinds h2"
    by(simp add: character_data_ptr_kinds_def)
  have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
    using node_ptr_kinds_eq_h2
    by(simp add: element_ptr_kinds_def)

  have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
    apply(rule writes_small_big[where P="λh h'. object_ptr_kinds h' = object_ptr_kinds h",
          OF set_shadow_root_writes h'])
    using set_shadow_root_pointers_preserved
    by (auto simp add: reflp_def transp_def)
  then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
    by (auto simp add: document_ptr_kinds_def)
  have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
    using object_ptr_kinds_eq_h3
    by(auto simp add: node_ptr_kinds_def)
  then have character_data_ptr_kinds_eq_h3: "character_data_ptr_kinds h' = character_data_ptr_kinds h3"
    by(simp add: character_data_ptr_kinds_def)
  have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
    using node_ptr_kinds_eq_h3
    by(simp add: element_ptr_kinds_def)


  have children_eq_h: "⋀(ptr'::(_) object_ptr) children. ptr' ≠ cast new_shadow_root_ptr
                ⟹ h ⊢ get_child_nodes ptr' →r children = h2 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads h2 get_child_nodes_new_shadow_root[rotated, OF new_shadow_root_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have children_eq2_h: "⋀ptr'. ptr' ≠ cast new_shadow_root_ptr
                                 ⟹ |h ⊢ get_child_nodes ptr'|r = |h2 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force

  have "h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []"
    using h2 local.new_shadow_root_no_child_nodes new_shadow_root_ptr by auto

  have disconnected_nodes_eq_h:
    "⋀doc_ptr disc_nodes. h ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                             = h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using get_disconnected_nodes_reads h2
      get_disconnected_nodes_new_shadow_root[rotated, OF h2,rotated,OF new_shadow_root_ptr]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by (metis (no_types, lifting))+
  then have disconnected_nodes_eq2_h:
    "⋀doc_ptr. |h ⊢ get_disconnected_nodes doc_ptr|r = |h2 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force

  have tag_name_eq_h:
    "⋀ptr' disc_nodes. h ⊢ get_tag_name ptr' →r disc_nodes
                                             = h2 ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads h2
      get_tag_name_new_shadow_root[OF new_shadow_root_ptr h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    by blast+
  then have tag_name_eq2_h: "⋀ptr'. |h ⊢ get_tag_name ptr'|r = |h2 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have children_eq_h2:
    "⋀ptr' children. h2 ⊢ get_child_nodes ptr' →r children = h3 ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads set_mode_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_mode_get_child_nodes)
  then have children_eq2_h2:
    "⋀ptr'. |h2 ⊢ get_child_nodes ptr'|r = |h3 ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h2:
    "⋀doc_ptr disc_nodes. h2 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                                              = h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using get_disconnected_nodes_reads set_mode_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_mode_get_disconnected_nodes)
  then have disconnected_nodes_eq2_h2:
    "⋀doc_ptr. |h2 ⊢ get_disconnected_nodes doc_ptr|r = |h3 ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h2:
    "⋀ptr' disc_nodes. h2 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h3 ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads set_mode_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_mode_get_tag_name)
  then have tag_name_eq2_h2: "⋀ptr'. |h2 ⊢ get_tag_name ptr'|r = |h3 ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have "type_wf h2"
    using ‹type_wf h› new_shadow_root_types_preserved h2 by blast
  then have "type_wf h3"
    using writes_small_big[where P="λh h'. type_wf h ⟶ type_wf h'", OF set_mode_writes h3]
    using  set_mode_types_preserved
    by(auto simp add: reflp_def transp_def)
  then show "type_wf h'"
    using writes_small_big[where P="λh h'. type_wf h ⟶ type_wf h'", OF set_shadow_root_writes h']
    using  set_shadow_root_types_preserved
    by(auto simp add: reflp_def transp_def)

  have children_eq_h3:
    "⋀ptr' children. h3 ⊢ get_child_nodes ptr' →r children = h' ⊢ get_child_nodes ptr' →r children"
    using CD.get_child_nodes_reads set_shadow_root_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_shadow_root_get_child_nodes)
  then have children_eq2_h3:
    " ⋀ptr'. |h3 ⊢ get_child_nodes ptr'|r = |h' ⊢ get_child_nodes ptr'|r"
    using select_result_eq by force
  have disconnected_nodes_eq_h3: "⋀doc_ptr disc_nodes. h3 ⊢ get_disconnected_nodes doc_ptr →r disc_nodes
                            = h' ⊢ get_disconnected_nodes doc_ptr →r disc_nodes"
    using get_disconnected_nodes_reads set_shadow_root_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_shadow_root_get_disconnected_nodes)
  then have disconnected_nodes_eq2_h3:
    "⋀doc_ptr. |h3 ⊢ get_disconnected_nodes doc_ptr|r = |h' ⊢ get_disconnected_nodes doc_ptr|r"
    using select_result_eq by force
  have tag_name_eq_h3:
    "⋀ptr' disc_nodes. h3 ⊢ get_tag_name ptr' →r disc_nodes
                                             = h' ⊢ get_tag_name ptr' →r disc_nodes"
    using get_tag_name_reads set_shadow_root_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_shadow_root_get_tag_name)
  then have tag_name_eq2_h3: "⋀ptr'. |h3 ⊢ get_tag_name ptr'|r = |h' ⊢ get_tag_name ptr'|r"
    using select_result_eq by force

  have "acyclic (parent_child_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
  also have "parent_child_rel h = parent_child_rel h2"
  proof(auto simp add: CD.parent_child_rel_def)[1]
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h2"
      by (simp add: object_ptr_kinds_eq_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h"
      and 1: "x ∈ set |h ⊢ get_child_nodes a|r"
    then show "x ∈ set |h2 ⊢ get_child_nodes a|r"
      by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
          ‹cast new_shadow_root_ptr ∉ set |h ⊢ object_ptr_kinds_M|r› children_eq2_h)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "a |∈| object_ptr_kinds h"
      using object_ptr_kinds_eq_h ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []›
      by(auto)
  next
    fix a x
    assume 0: "a |∈| object_ptr_kinds h2"
      and 1: "x ∈ set |h2 ⊢ get_child_nodes a|r"
    then show "x ∈ set |h ⊢ get_child_nodes a|r"
      by (metis (no_types, lifting) ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []›
          children_eq2_h empty_iff empty_set image_eqI select_result_I2)
  qed
  also have "… = parent_child_rel h3"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
  also have "… = parent_child_rel h'"
    by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
  finally have "CD.a_acyclic_heap h'"
    by (simp add: CD.acyclic_heap_def)

  have "CD.a_all_ptrs_in_heap h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_all_ptrs_in_heap h2"
    apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
    using node_ptr_kinds_eq_h
      ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []›
    apply (metis (no_types, lifting) CD.get_child_nodes_ok CD.l_heap_is_wellformedCore_DOM_axioms
        ‹known_ptrs h2› ‹parent_child_rel h = parent_child_rel h2› ‹type_wf h2› assms(1) assms(2)
        l_heap_is_wellformedCore_DOM.parent_child_rel_child local.known_ptrs_known_ptr
        local.parent_child_rel_child_in_heap node_ptr_kinds_commutes returns_result_select_result)
    by (metis assms(1) assms(2) disconnected_nodes_eq2_h document_ptr_kinds_eq_h
        local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h
        returns_result_select_result)
  then have "CD.a_all_ptrs_in_heap h3"
    by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
  then have "CD.a_all_ptrs_in_heap h'"
    by (simp add: children_eq2_h3 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
        CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3)

  have "CD.a_distinct_lists h"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_distinct_lists h2"
    using ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []› children_eq2_h
    apply(auto simp add: select_result_eq[OF disconnected_nodes_eq_h] CD.a_distinct_lists_def
        insort_split object_ptr_kinds_eq_h
        document_ptr_kinds_eq_h  disconnected_nodes_eq2_h intro!: distinct_concat_map_I
        dest: distinct_concat_map_E)[1]
    apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert_remove)
    apply(auto simp add:  dest: distinct_concat_map_E)[1]
    apply(case_tac "x = cast new_shadow_root_ptr")
    using ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []› children_eq2_h apply blast
    apply(case_tac "y = cast new_shadow_root_ptr")
    using ‹h2 ⊢ get_child_nodes (cast new_shadow_root_ptr) →r []› children_eq2_h apply blast
  proof -
    fix x y :: "(_) object_ptr"
    fix xa :: "(_) node_ptr"
    assume a1: "distinct (concat (map (λptr. |h ⊢ get_child_nodes ptr|r)
(sorted_list_of_set (fset (object_ptr_kinds h)))))"
    assume "x ≠ y"
    assume "xa ∈ set |h2 ⊢ get_child_nodes x|r"
    assume "xa ∈ set |h2 ⊢ get_child_nodes y|r"
    assume "x |∈| object_ptr_kinds h"
    assume "x ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr"
    assume "y |∈| object_ptr_kinds h"
    assume "y ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr"
    show False
      using distinct_concat_map_E(1)[OF a1, of x y]
      using ‹x |∈| object_ptr_kinds h› ‹y |∈| object_ptr_kinds h›
      using ‹xa ∈ set |h2 ⊢ get_child_nodes x|r› ‹xa ∈ set |h2 ⊢ get_child_nodes y|r›
      using ‹x ≠ y›
      by(auto simp add: children_eq2_h[OF ‹x ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr›]
          children_eq2_h[OF ‹y ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr›])
  next
    fix x :: "(_) node_ptr"
    fix xa :: "(_) object_ptr"
    fix xb :: "(_) document_ptr"
    assume "(⋃x∈fset (object_ptr_kinds h). set |h ⊢ get_child_nodes x|r) ∩
(⋃x∈fset (document_ptr_kinds h). set |h2 ⊢ get_disconnected_nodes x|r) = {}"
    assume "x ∈ set |h2 ⊢ get_child_nodes xa|r"
    assume "xb |∈| document_ptr_kinds h"
    assume "x ∈ set |h2 ⊢ get_disconnected_nodes xb|r"
    assume "xa |∈| object_ptr_kinds h"
    assume "xa ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr"
    have "set |h ⊢ get_child_nodes xa|r ∩ set |h2 ⊢ get_disconnected_nodes xb|r = {}"
      by (metis (no_types, lifting) CD.get_child_nodes_ok ‹xa |∈| object_ptr_kinds h›
          ‹xb |∈| document_ptr_kinds h› assms(1) assms(2) assms(3) disconnected_nodes_eq2_h
          is_OK_returns_result_E local.get_disconnected_nodes_ok
          local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr select_result_I2)
    then
    show "False"
      using ‹x ∈ set |h2 ⊢ get_child_nodes xa|r› ‹x ∈ set |h2 ⊢ get_disconnected_nodes xb|r›
        ‹xa ≠ castshadow_root_ptr2object_ptr new_shadow_root_ptr› children_eq2_h by auto
  qed

  then have "CD.a_distinct_lists h3"
    by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
        children_eq2_h2 object_ptr_kinds_eq_h2)[1]
  then have "CD.a_distinct_lists h'"
    by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
        object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)

  have "CD.a_owner_document_valid h"
    using ‹heap_is_wellformed h›  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
  then have "CD.a_owner_document_valid h'"
    (* using disc_nodes_h3 ‹document_ptr |∈| document_ptr_kinds h› *)
    apply(simp add: CD.a_owner_document_valid_def)
    apply(simp add: object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )
    apply(simp add: object_ptr_kinds_eq_h2)
    apply(simp add: document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )
    apply(simp add: document_ptr_kinds_eq_h2)
    apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )
    apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )
    apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
        disconnected_nodes_eq2_h
        disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1]
    by (metis CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
        ‹castshadow_root_ptr2object_ptr new_shadow_root_ptr ∉ set |h ⊢ object_ptr_kinds_M|r› assms(2) assms(3)
        children_eq2_h children_eq_h document_ptr_kinds_eq_h is_OK_returns_result_I
        l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.known_ptrs_known_ptr object_ptr_kinds_M_def
        returns_result_select_result)

  have shadow_root_eq_h:
    "⋀character_data_ptr shadow_root_opt. h ⊢ get_shadow_root character_data_ptr →r shadow_root_opt =
h2 ⊢ get_shadow_root character_data_ptr →r shadow_root_opt"
    using get_shadow_root_reads h2 get_shadow_root_new_shadow_root[rotated, OF h2]
    apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
    using local.get_shadow_root_locs_impl new_shadow_root_ptr apply blast
    using local.get_shadow_root_locs_impl new_shadow_root_ptr by blast


  have shadow_root_eq_h2:
    "⋀ptr' children. h2 ⊢ get_shadow_root ptr' →r children = h3 ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_mode_writes h3
    apply(rule reads_writes_preserved)
    by(auto simp add: set_mode_get_shadow_root)
  have shadow_root_eq_h3:
    "⋀ptr' children. element_ptr ≠ ptr' ⟹ h3 ⊢ get_shadow_root ptr' →r children =
h' ⊢ get_shadow_root ptr' →r children"
    using get_shadow_root_reads set_shadow_root_writes h'
    apply(rule reads_writes_preserved)
    by(auto simp add: set_shadow_root_get_shadow_root_different_pointers)
  have shadow_root_h3: "h' ⊢ get_shadow_root element_ptr →r Some new_shadow_root_ptr"
    using ‹type_wf h3› h' local.set_shadow_root_get_shadow_root by blast


  have "a_all_ptrs_in_heap h"
    by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
  then have "a_all_ptrs_in_heap h2"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
    using returns_result_eq shadow_root_eq_h by fastforce
  then have "a_all_ptrs_in_heap h3"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
    using shadow_root_eq_h2 by blast
  then have "a_all_ptrs_in_heap h'"
    apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
    apply(case_tac "shadow_root_ptr = new_shadow_root_ptr")
    using h2 newShadowRoot_M_ptr_in_heap new_shadow_root_ptr shadow_root_ptr_kinds_eq_h2 apply blast
    using ‹type_wf h3› h' local.set_shadow_root_get_shadow_root returns_result_eq shadow_root_eq_h3
    apply fastforce
    done

  have "a_distinct_lists h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then have "a_distinct_lists h2"
    apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
    apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
    by (metis ‹type_wf h2› assms(1) assms(2) local.get_shadow_root_ok local.shadow_root_same_host
        returns_result_select_result shadow_root_eq_h)
  then have "a_distinct_lists h3"
    by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2
        select_result_eq[OF shadow_root_eq_h2])
  then have "a_distinct_lists h'"
    apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3
        select_result_eq[OF shadow_root_eq_h3])[1]
    apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
    by (smt (verit, best) ShadowRootMonad.ptr_kinds_ptr_kinds_M ‹new_shadow_root_ptr ∉ set |h ⊢
        shadow_root_ptr_kinds_M|r› ‹type_wf h'› assms(1) assms(2) element_ptr_kinds_eq_h3
        l_heap_is_wellformedShadow_DOM.shadow_root_same_host local.get_shadow_root_ok
        local.get_shadow_root_shadow_root_ptr_in_heap
        local.l_heap_is_wellformedShadow_DOM_axioms returns_result_select_result
        select_result_I2 shadow_root_eq_h shadow_root_eq_h2 shadow_root_eq_h3 shadow_root_h3)

  have "a_shadow_root_valid h"
    using assms(1)
    by (simp add: heap_is_wellformed_def)
  then
  have "a_shadow_root_valid h'"
  proof(unfold a_shadow_root_valid_def; safe)
    fix shadow_root_ptr
    assume "∀shadow_root_ptr∈fset (shadow_root_ptr_kinds h). ∃host∈fset (element_ptr_kinds h).
|h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
|h ⊢ get_shadow_root host|r = Some shadow_root_ptr"
    assume "a_shadow_root_valid h"
    assume "shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h')"
    show "∃host∈fset (element_ptr_kinds h').
|h' ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧ |h' ⊢ get_shadow_root host|r =
Some shadow_root_ptr"
    proof (cases "shadow_root_ptr = new_shadow_root_ptr")
      case True
      have "element_ptr ∈ fset (element_ptr_kinds h')"
        by (simp add: ‹element_ptr |∈| element_ptr_kinds h› element_ptr_kinds_eq_h
            element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h3)
      moreover have "|h' ⊢ get_tag_name element_ptr|r ∈ safe_shadow_root_element_types"
        by (smt (verit, best) ‹⋀thesis. (⋀h2 h3 new_shadow_root_ptr element_tag_name. ⟦h ⊢
            get_tag_name element_ptr →r element_tag_name; element_tag_name ∈
            safe_shadow_root_element_types; h ⊢ get_shadow_root element_ptr →r None; h ⊢
            newShadowRoot_M →h h2; h ⊢ newShadowRoot_M →r new_shadow_root_ptr; h2
            ⊢ set_mode new_shadow_root_ptr new_mode →h h3; h3 ⊢ set_shadow_root element_ptr (Some
            new_shadow_root_ptr) →h h'⟧ ⟹ thesis) ⟹ thesis› select_result_I2 tag_name_eq2_h2
            tag_name_eq2_h3 tag_name_eq_h)
      moreover have "|h' ⊢ get_shadow_root element_ptr|r = Some shadow_root_ptr"
        using shadow_root_h3
        by (simp add: True)
      ultimately
      show ?thesis
        by meson
    next
      case False
      then obtain host where host: "host ∈ fset (element_ptr_kinds h)" and
        "|h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types" and
        "|h ⊢ get_shadow_root host|r = Some shadow_root_ptr"
        using ‹shadow_root_ptr ∈ fset (shadow_root_ptr_kinds h')›
        using ‹∀shadow_root_ptr∈fset (shadow_root_ptr_kinds h). ∃host∈fset (element_ptr_kinds h).
|h ⊢ get_tag_name host|r ∈ safe_shadow_root_element_types ∧
|h ⊢ get_shadow_root host|r = Some shadow_root_ptr›
        apply(simp add: shadow_root_ptr_kinds_eq_h3 shadow_root_ptr_kinds_eq_h2
            shadow_root_ptr_kinds_eq_h)
        by meson
      moreover have "host ≠ element_ptr"
        using calculation(3) prev_shadow_root by auto
      ultimately show ?thesis
        using element_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h
        by (metis (no_types, opaque_lifting) assms(2)
            l_get_shadow_rootShadow_DOM.get_shadow_root_ok
            local.l_get_shadow_rootShadow_DOM_axioms returns_result_select_result
            select_result_I2 shadow_root_eq_h shadow_root_eq_h2 shadow_root_eq_h3 tag_name_eq2_h
            tag_name_eq2_h2 tag_name_eq2_h3)
    qed
  qed


  have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
        select_result_eq[OF shadow_root_eq_h])
  have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
    by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2
        select_result_eq[OF shadow_root_eq_h2])
  have "a_host_shadow_root_rel h' = {(cast element_ptr, cast new_shadow_root_ptr)} ∪
a_host_shadow_root_rel h3"
    apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3 )[1]
    apply(case_tac "element_ptr ≠ aa")
    using select_result_eq[OF shadow_root_eq_h3] apply (simp add: image_iff)
    using select_result_eq[OF shadow_root_eq_h3]
    apply (metis (no_types, lifting)
        ‹local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2›
        ‹local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3› ‹type_wf h3›
        host_shadow_root_rel_def local.get_shadow_root_impl local.get_shadow_root_ok
        option.distinct(1) prev_shadow_root returns_result_select_result)
    apply (metis (mono_tags, lifting) ‹⋀ptr'. (⋀x. element_ptr ≠ ptr') ⟹
|h3 ⊢ get_shadow_root ptr'|r = |h' ⊢ get_shadow_root ptr'|r› case_prod_conv image_iff
        is_OK_returns_result_I mem_Collect_eq option.inject returns_result_eq
        returns_result_select_result shadow_root_h3)
    using element_ptr_kinds_eq_h3 local.get_shadow_root_ptr_in_heap shadow_root_h3 apply fastforce
    using Shadow_DOM.a_host_shadow_root_rel_def ‹⋀ptr'. (⋀x. element_ptr ≠ ptr') ⟹
|h3 ⊢ get_shadow_root ptr'|r = |h' ⊢ get_shadow_root ptr'|r› ‹type_wf h3› case_prodE case_prodI
        host_shadow_root_rel_shadow_root image_iff local.get_shadow_root_impl local.get_shadow_root_ok
        mem_Collect_eq option.discI prev_shadow_root returns_result_select_result select_result_I2
        shadow_root_eq_h shadow_root_eq_h2
    by (smt (verit))
  have "acyclic (parent_child_rel h ∪ a_host_shadow_root_rel h)"
    using ‹heap_is_wellformed h›
    by (simp add: heap_is_wellformed_def)
  have "parent_child_rel h ∪ a_host_shadow_root_rel h =
parent_child_rel h2 ∪ a_host_shadow_root_rel h2"
    using ‹local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2›
      ‹parent_child_rel h = parent_child_rel h2› by auto
  have "parent_child_rel h2 ∪ a_host_shadow_root_rel h2 =
parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    using ‹local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3›
      ‹parent_child_rel h2 = parent_child_rel h3› by auto
  have "parent_child_rel h' ∪ a_host_shadow_root_rel h' =
{(cast element_ptr, cast new_shadow_root_ptr)} ∪ parent_child_rel h3 ∪ a_host_shadow_root_rel h3"
    by (simp add: ‹local.a_host_shadow_root_rel h' =
{(castelement_ptr2object_ptr element_ptr, castshadow_root_ptr2object_ptr new_shadow_root_ptr)} ∪
local.a_host_shadow_root_rel h3› ‹parent_child_rel h3 = parent_child_rel h'›)

  have "⋀a b. (a, b) ∈ parent_child_rel h3 ⟹ a ≠ cast new_shadow_root_ptr"
    using CD.parent_child_rel_parent_in_heap ‹parent_child_rel h = parent_child_rel h2›
      ‹parent_child_rel h2 = parent_child_rel h3› document_ptr_kinds_commutes
    by (metis h2 newShadowRoot_M_ptr_not_in_heap new_shadow_root_ptr shadow_root_ptr_kinds_commutes)
  moreover
  have "⋀a b. (a, b) ∈ a_host_shadow_root_rel h3 ⟹ a ≠ cast new_shadow_root_ptr"
    using shadow_root_eq_h2
    by(auto simp add: a_host_shadow_root_rel_def)
  moreover
  have "cast new_shadow_root_ptr ∉ {x. (x, cast element_ptr) ∈ (parent_child_rel h3 ∪
a_host_shadow_root_rel h3)*}"
    by (metis (no_types, lifting) UnE calculation(1) calculation(2)
        cast_shadow_root_ptr_not_node_ptr(1) converse_rtranclE mem_Collect_eq)
  moreover
  have "acyclic (parent_child_rel h3 ∪ a_host_shadow_root_rel h3)"
    using ‹acyclic (parent_child_rel h ∪ local.a_host_shadow_root_rel h)›
      ‹parent_child_rel h ∪ local.a_host_shadow_root_rel h =
parent_child_rel h2 ∪ local.a_host_shadow_root_rel h2› ‹parent_child_rel h2 ∪
local.a_host_shadow_root_rel h2 = parent_child_rel h3 ∪ local.a_host_shadow_root_rel h3›
    by auto
  ultimately have "acyclic (parent_child_rel h' ∪ a_host_shadow_root_rel h')"
    by(simp add: ‹parent_child_rel h' ∪ a_host_shadow_root_rel h' =
{(cast element_ptr, cast new_shadow_root_ptr)} ∪ parent_child_rel h3 ∪
a_host_shadow_root_rel h3›)

  have "CD.a_heap_is_wellformed h'"
    apply(simp add: CD.a_heap_is_wellformed_def)
    by (simp add: ‹local.CD.a_acyclic_heap h'› ‹local.CD.a_all_ptrs_in_heap h'›
        ‹local.CD.a_distinct_lists h'› ‹local.CD.a_owner_document_valid h'›)

  show "heap_is_wellformed h' "
    using ‹acyclic (parent_child_rel h' ∪ local.a_host_shadow_root_rel h')›
    by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl ‹local.CD.a_heap_is_wellformed h'›
        ‹local.a_all_ptrs_in_heap h'› ‹local.a_distinct_lists h'› ‹local.a_shadow_root_valid h'›)
qed
end

interpretation l_attach_shadow_root_wf?: l_attach_shadow_root_wfShadow_DOM known_ptr known_ptrs type_wf
  get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
  heap_is_wellformed parent_child_rel set_tag_name set_tag_name_locs set_disconnected_nodes
  set_disconnected_nodes_locs create_element get_shadow_root get_shadow_root_locs get_tag_name
  get_tag_name_locs heap_is_wellformedCore_DOM get_host get_host_locs get_disconnected_document
  get_disconnected_document_locs set_val set_val_locs create_character_data DocumentClass.known_ptr
  DocumentClass.type_wf set_shadow_root set_shadow_root_locs set_mode set_mode_locs attach_shadow_root
  by(auto simp add: l_attach_shadow_root_wfShadow_DOM_def instances)
declare l_attach_shadow_root_wfShadow_DOM_axioms [instances]

end