From fb49067a8db3e8bd573068a0834e32d6144f5ebe Mon Sep 17 00:00:00 2001 From: "Achim D. Brucker" Date: Sat, 23 May 2020 11:53:43 +0100 Subject: [PATCH] Updated files to match development version of AFP. --- Core_DOM/ROOT | 16 +- Core_DOM/{ => common}/Core_DOM.thy | 0 .../{ => common}/Core_DOM_Basic_Datatypes.thy | 0 Core_DOM/{ => common}/Core_DOM_Functions.thy | 238 +- Core_DOM/{ => common}/Core_DOM_Tests.thy | 0 Core_DOM/{ => common}/classes/BaseClass.thy | 0 .../classes/CharacterDataClass.thy | 19 +- .../{ => common}/classes/DocumentClass.thy | 20 +- Core_DOM/{ => common}/classes/NodeClass.thy | 22 +- Core_DOM/{ => common}/classes/ObjectClass.thy | 34 +- Core_DOM/{ => common}/monads/BaseMonad.thy | 0 .../monads/CharacterDataMonad.thy | 49 +- .../{ => common}/monads/DocumentMonad.thy | 44 +- Core_DOM/{ => common}/monads/ElementMonad.thy | 72 +- Core_DOM/{ => common}/monads/NodeMonad.thy | 10 +- Core_DOM/{ => common}/monads/ObjectMonad.thy | 11 + .../pointers/CharacterDataPointer.thy | 0 .../{ => common}/pointers/DocumentPointer.thy | 0 .../{ => common}/pointers/ElementPointer.thy | 0 .../{ => common}/pointers/NodePointer.thy | 0 .../{ => common}/pointers/ObjectPointer.thy | 0 Core_DOM/{ => common}/pointers/Ref.thy | 0 .../preliminaries/Heap_Error_Monad.thy | 24 + .../preliminaries/Hiding_Type_Variables.thy | 0 .../common/preliminaries/Testing_Utils.thy | 92 + .../{ => common}/tests/Core_DOM_BaseTest.thy | 33 - .../tests/Document-adoptNode.html | 0 .../tests/Document-getElementById.html | 0 .../{ => common}/tests/Document_adoptNode.thy | 28 +- .../tests/Document_getElementById.thy | 120 +- .../{ => common}/tests/Node-insertBefore.html | 0 .../{ => common}/tests/Node-removeChild.html | 0 .../{ => common}/tests/Node_insertBefore.thy | 40 +- .../{ => common}/tests/Node_removeChild.thy | 28 +- Core_DOM/preliminaries/Testing_Utils.thy | 39 - Core_DOM/{ => standard}/Core_DOM_Heap_WF.thy | 2067 +++++++++++++++-- .../{ => standard}/classes/ElementClass.thy | 23 +- .../pointers/ShadowRootPointer.thy | 8 +- 38 files changed, 2459 insertions(+), 578 deletions(-) rename Core_DOM/{ => common}/Core_DOM.thy (100%) rename Core_DOM/{ => common}/Core_DOM_Basic_Datatypes.thy (100%) rename Core_DOM/{ => common}/Core_DOM_Functions.thy (93%) rename Core_DOM/{ => common}/Core_DOM_Tests.thy (100%) rename Core_DOM/{ => common}/classes/BaseClass.thy (100%) rename Core_DOM/{ => common}/classes/CharacterDataClass.thy (96%) rename Core_DOM/{ => common}/classes/DocumentClass.thy (96%) rename Core_DOM/{ => common}/classes/NodeClass.thy (92%) rename Core_DOM/{ => common}/classes/ObjectClass.thy (89%) rename Core_DOM/{ => common}/monads/BaseMonad.thy (100%) rename Core_DOM/{ => common}/monads/CharacterDataMonad.thy (94%) rename Core_DOM/{ => common}/monads/DocumentMonad.thy (94%) rename Core_DOM/{ => common}/monads/ElementMonad.thy (87%) rename Core_DOM/{ => common}/monads/NodeMonad.thy (97%) rename Core_DOM/{ => common}/monads/ObjectMonad.thy (96%) rename Core_DOM/{ => common}/pointers/CharacterDataPointer.thy (100%) rename Core_DOM/{ => common}/pointers/DocumentPointer.thy (100%) rename Core_DOM/{ => common}/pointers/ElementPointer.thy (100%) rename Core_DOM/{ => common}/pointers/NodePointer.thy (100%) rename Core_DOM/{ => common}/pointers/ObjectPointer.thy (100%) rename Core_DOM/{ => common}/pointers/Ref.thy (100%) rename Core_DOM/{ => common}/preliminaries/Heap_Error_Monad.thy (96%) rename Core_DOM/{ => common}/preliminaries/Hiding_Type_Variables.thy (100%) create mode 100644 Core_DOM/common/preliminaries/Testing_Utils.thy rename Core_DOM/{ => common}/tests/Core_DOM_BaseTest.thy (93%) rename Core_DOM/{ => common}/tests/Document-adoptNode.html (100%) rename Core_DOM/{ => common}/tests/Document-getElementById.html (100%) rename Core_DOM/{ => common}/tests/Document_adoptNode.thy (82%) rename Core_DOM/{ => common}/tests/Document_getElementById.thy (68%) rename Core_DOM/{ => common}/tests/Node-insertBefore.html (100%) rename Core_DOM/{ => common}/tests/Node-removeChild.html (100%) rename Core_DOM/{ => common}/tests/Node_insertBefore.thy (77%) rename Core_DOM/{ => common}/tests/Node_removeChild.thy (86%) delete mode 100644 Core_DOM/preliminaries/Testing_Utils.thy rename Core_DOM/{ => standard}/Core_DOM_Heap_WF.thy (73%) rename Core_DOM/{ => standard}/classes/ElementClass.thy (95%) rename Core_DOM/{ => standard}/pointers/ShadowRootPointer.thy (95%) diff --git a/Core_DOM/ROOT b/Core_DOM/ROOT index 61eeed0..dc5212e 100644 --- a/Core_DOM/ROOT +++ b/Core_DOM/ROOT @@ -3,14 +3,18 @@ chapter AFP session "Core_DOM-devel" (AFP) = "HOL-Library" + options [timeout = 1200] directories - "classes" - "monads" - "pointers" - "preliminaries" - "tests" + "common" + "common/classes" + "common/monads" + "common/pointers" + "common/preliminaries" + "common/tests" + "standard" + "standard/classes" + "standard/pointers" theories Core_DOM Core_DOM_Tests - document_files + document_files (in "document") "root.tex" "root.bib" diff --git a/Core_DOM/Core_DOM.thy b/Core_DOM/common/Core_DOM.thy similarity index 100% rename from Core_DOM/Core_DOM.thy rename to Core_DOM/common/Core_DOM.thy diff --git a/Core_DOM/Core_DOM_Basic_Datatypes.thy b/Core_DOM/common/Core_DOM_Basic_Datatypes.thy similarity index 100% rename from Core_DOM/Core_DOM_Basic_Datatypes.thy rename to Core_DOM/common/Core_DOM_Basic_Datatypes.thy diff --git a/Core_DOM/Core_DOM_Functions.thy b/Core_DOM/common/Core_DOM_Functions.thy similarity index 93% rename from Core_DOM/Core_DOM_Functions.thy rename to Core_DOM/common/Core_DOM_Functions.thy index 851d76c..deae67a 100644 --- a/Core_DOM/Core_DOM_Functions.thy +++ b/Core_DOM/common/Core_DOM_Functions.thy @@ -620,6 +620,62 @@ lemma set_child_nodes_get_child_nodes_different_pointers: apply(rule is_element_ptr_kind_obtains) apply(auto) done + +lemma set_child_nodes_element_ok [simp]: + assumes "known_ptr ptr" + assumes "type_wf h" + assumes "ptr |\| object_ptr_kinds h" + assumes "is_element_ptr_kind ptr" + shows "h \ ok (set_child_nodes ptr children)" +proof - + have "is_element_ptr ptr" + using \known_ptr ptr\ assms(4) + by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then show ?thesis + using assms + apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] + by (simp add: DocumentMonad.put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok local.type_wf_impl) +qed + +lemma set_child_nodes_document1_ok [simp]: + assumes "known_ptr ptr" + assumes "type_wf h" + assumes "ptr |\| object_ptr_kinds h" + assumes "is_document_ptr_kind ptr" + assumes "children = []" + shows "h \ ok (set_child_nodes ptr children)" +proof - + have "is_document_ptr ptr" + using \known_ptr ptr\ assms(4) + by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then show ?thesis + using assms + apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] + by (simp add: DocumentMonad.put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok local.type_wf_impl) +qed + +lemma set_child_nodes_document2_ok [simp]: + assumes "known_ptr ptr" + assumes "type_wf h" + assumes "ptr |\| object_ptr_kinds h" + assumes "is_document_ptr_kind ptr" + assumes "children = [child]" + assumes "is_element_ptr_kind child" + shows "h \ ok (set_child_nodes ptr children)" +proof - + have "is_document_ptr ptr" + using \known_ptr ptr\ assms(4) + by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then show ?thesis + using assms + apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) + apply(split invoke_splits, rule conjI)+ + apply(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] + apply(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] + apply (simp add: local.type_wf_impl put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok) + apply(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] + by(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] +qed end locale l_set_child_nodes_get_child_nodes = l_get_child_nodes + l_set_child_nodes + @@ -2358,6 +2414,15 @@ proof - using assms(1) get_child_nodes_ptr_in_heap by blast qed + +lemma remove_child_child_in_heap: + assumes "h \ remove_child ptr' child \\<^sub>h h'" + shows "child |\| node_ptr_kinds h" + using assms + apply(auto simp add: remove_child_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] split: if_splits)[1] + by (meson is_OK_returns_result_I local.get_owner_document_ptr_in_heap node_ptr_kinds_commutes) + + lemma remove_child_in_disconnected_nodes: (* assumes "known_ptrs h" *) assumes "h \ remove_child ptr child \\<^sub>h h'" @@ -2490,6 +2555,7 @@ locale l_remove_child = l_type_wf + l_known_ptrs + l_remove_child_defs + l_get_o \ h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes \ child \ set disc_nodes" assumes remove_child_ptr_in_heap: "h \ ok (remove_child ptr child) \ ptr |\| object_ptr_kinds h" + assumes remove_child_child_in_heap: "h \ remove_child ptr' child \\<^sub>h h' \ child |\| node_ptr_kinds h" assumes remove_child_children_subset: "known_ptrs h \ type_wf h \ h \ remove_child parent child \\<^sub>h h' \ h \ get_child_nodes ptr \\<^sub>r children @@ -2535,6 +2601,7 @@ lemma remove_child_is_l_remove_child [instances]: using remove_child_types_preserved apply(blast) using remove_child_in_disconnected_nodes apply(blast) using remove_child_ptr_in_heap apply(blast) + using remove_child_child_in_heap apply(blast) using remove_child_children_subset apply(blast) done @@ -2975,8 +3042,8 @@ lemma insert_before_list_in_set: "x \ set (insert_before_list v ref xs) \ set xs \ distinct xs \ distinct (insert_before_list x ref xs)" - by (induct x ref xs rule: insert_before_list.induct) - (auto simp add: insert_before_list_in_set) + apply(induct x ref xs rule: insert_before_list.induct) + by(auto simp add: insert_before_list_in_set) lemma insert_before_list_subset: "set xs \ set (insert_before_list x ref xs)" apply(induct x ref xs rule: insert_before_list.induct) @@ -3012,6 +3079,13 @@ proof - unfolding insert_before_def by auto qed +lemma insert_before_ptr_in_heap: + assumes "h \ ok (insert_before ptr node reference_child)" + shows "ptr |\| object_ptr_kinds h" + using assms + apply(auto simp add: insert_before_def elim!: bind_is_OK_E)[1] + by (metis (mono_tags, lifting) ensure_pre_insertion_validity_pure is_OK_returns_result_I local.get_owner_document_ptr_in_heap next_sibling_pure pure_returns_heap_eq return_returns_heap) + lemma insert_before_child_in_heap: assumes "h \ ok (insert_before ptr node reference_child)" shows "node |\| node_ptr_kinds h" @@ -3166,20 +3240,76 @@ global_interpretation l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\< . locale l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + - l_create_element_defs + + l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_type set_tag_type_locs + + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + + l_set_tag_type type_wf set_tag_type set_tag_type_locs + + l_create_element_defs create_element + + 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_type :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_tag_type_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" + + assumes known_ptr_impl: "known_ptr = a_known_ptr" assumes create_element_impl: "create_element = a_create_element" begin lemmas create_element_def = a_create_element_def[folded create_element_impl] + +lemma create_element_document_in_heap: + assumes "h \ ok (create_element document_ptr tag)" + shows "document_ptr |\| document_ptr_kinds h" +proof - + obtain h' where "h \ create_element document_ptr tag \\<^sub>h h'" + using assms(1) + by auto + then + obtain new_element_ptr h2 h3 disc_nodes_h3 where + new_element_ptr: "h \ new_element \\<^sub>r new_element_ptr" and + h2: "h \ new_element \\<^sub>h h2" and + h3: "h2 \ set_tag_type new_element_ptr tag \\<^sub>h h3" and + disc_nodes_h3: "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" and + h': "h3 \ set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes_h3) \\<^sub>h h'" + by(auto simp add: create_element_def + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_element_ptr|}" + using new_element_new_ptr h2 new_element_ptr by blast + + moreover 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_type_writes h3]) + using set_tag_type_pointers_preserved + by (auto simp add: reflp_def transp_def) + moreover have "document_ptr |\| document_ptr_kinds h3" + by (meson disc_nodes_h3 is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) + + ultimately show ?thesis + by (auto simp add: document_ptr_kinds_def) +qed + +lemma create_element_known_ptr: + assumes "h \ create_element document_ptr tag \\<^sub>r new_element_ptr" + shows "known_ptr (cast new_element_ptr)" +proof - + have "is_element_ptr new_element_ptr" + using assms + apply(auto simp add: create_element_def elim!: bind_returns_result_E)[1] + using new_element_is_element_ptr + by blast + then show ?thesis + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs) +qed end locale l_create_element = l_create_element_defs interpretation - i_create_element?: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs set_tag_type - set_tag_type_locs create_element - by unfold_locales (simp add: create_element_def) + i_create_element?: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_type set_tag_type_locs type_wf create_element known_ptr + by(auto simp add: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def create_element_def instances) declare l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -3217,20 +3347,76 @@ global_interpretation l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^ . locale l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + - l_create_character_data_defs + + l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + + l_set_val type_wf set_val set_val_locs + + l_create_character_data_defs create_character_data + + 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_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and type_wf :: "(_) heap \ bool" + and create_character_data :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) character_data_ptr) prog" + and known_ptr :: "(_) object_ptr \ bool" + + assumes known_ptr_impl: "known_ptr = a_known_ptr" assumes create_character_data_impl: "create_character_data = a_create_character_data" begin lemmas create_character_data_def = a_create_character_data_def[folded create_character_data_impl] + +lemma create_character_data_document_in_heap: + assumes "h \ ok (create_character_data document_ptr text)" + shows "document_ptr |\| document_ptr_kinds h" +proof - + obtain h' where "h \ create_character_data document_ptr text \\<^sub>h h'" + using assms(1) + by auto + then + obtain new_character_data_ptr h2 h3 disc_nodes_h3 where + new_character_data_ptr: "h \ new_character_data \\<^sub>r new_character_data_ptr" and + h2: "h \ new_character_data \\<^sub>h h2" and + h3: "h2 \ set_val new_character_data_ptr text \\<^sub>h h3" and + disc_nodes_h3: "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" and + h': "h3 \ set_disconnected_nodes document_ptr (cast new_character_data_ptr # disc_nodes_h3) \\<^sub>h h'" + by(auto simp add: create_character_data_def + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" + using new_character_data_new_ptr h2 new_character_data_ptr by blast + + moreover 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_val_writes h3]) + using set_val_pointers_preserved + by (auto simp add: reflp_def transp_def) + moreover have "document_ptr |\| document_ptr_kinds h3" + by (meson disc_nodes_h3 is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) + + ultimately show ?thesis + by (auto simp add: document_ptr_kinds_def) +qed + +lemma create_character_data_known_ptr: + assumes "h \ create_character_data document_ptr text \\<^sub>r new_character_data_ptr" + shows "known_ptr (cast new_character_data_ptr)" +proof - + have "is_character_data_ptr new_character_data_ptr" + using assms + apply(auto simp add: create_character_data_def elim!: bind_returns_result_E)[1] + using new_character_data_is_character_data_ptr + by blast + then show ?thesis + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs) +qed end locale l_create_character_data = l_create_character_data_defs interpretation - i_create_character_data?: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_val set_val_locs get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs create_character_data - by unfold_locales (simp add: create_character_data_def) + i_create_character_data?: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs type_wf create_character_data known_ptr + by(auto simp add: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def create_character_data_def instances) declare l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] @@ -3486,6 +3672,30 @@ lemma get_element_by_id_result_in_tree_order: intro!: map_filter_M_pure map_M_pure_I bind_pure_I split: option.splits list.splits if_splits) +lemma get_elements_by_class_name_result_in_tree_order: + assumes "h \ get_elements_by_class_name ptr name \\<^sub>r results" + assumes "h \ to_tree_order ptr \\<^sub>r to" + assumes "element_ptr \ set results" + shows "cast element_ptr \ set to" + using assms + by(auto simp add: get_elements_by_class_name_def first_in_tree_order_def + elim!: map_filter_M_pure_E[where y=element_ptr] bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF assms(2), rotated] + intro!: map_filter_M_pure map_M_pure_I bind_pure_I + split: option.splits list.splits if_splits) + +lemma get_elements_by_tag_name_result_in_tree_order: + assumes "h \ get_elements_by_tag_name ptr name \\<^sub>r results" + assumes "h \ to_tree_order ptr \\<^sub>r to" + assumes "element_ptr \ set results" + shows "cast element_ptr \ set to" + using assms + by(auto simp add: get_elements_by_tag_name_def first_in_tree_order_def + elim!: map_filter_M_pure_E[where y=element_ptr] bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF assms(2), rotated] + intro!: map_filter_M_pure map_M_pure_I bind_pure_I + split: option.splits list.splits if_splits) + lemma get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag_name) h" by(auto simp add: get_elements_by_tag_name_def intro!: bind_pure_I map_filter_M_pure diff --git a/Core_DOM/Core_DOM_Tests.thy b/Core_DOM/common/Core_DOM_Tests.thy similarity index 100% rename from Core_DOM/Core_DOM_Tests.thy rename to Core_DOM/common/Core_DOM_Tests.thy diff --git a/Core_DOM/classes/BaseClass.thy b/Core_DOM/common/classes/BaseClass.thy similarity index 100% rename from Core_DOM/classes/BaseClass.thy rename to Core_DOM/common/classes/BaseClass.thy diff --git a/Core_DOM/classes/CharacterDataClass.thy b/Core_DOM/common/classes/CharacterDataClass.thy similarity index 96% rename from Core_DOM/classes/CharacterDataClass.thy rename to Core_DOM/common/classes/CharacterDataClass.thy index 7af6a67..f434a93 100644 --- a/Core_DOM/classes/CharacterDataClass.thy +++ b/Core_DOM/common/classes/CharacterDataClass.thy @@ -65,6 +65,7 @@ type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'docume 'Object, 'CharacterData option RCharacterData_ext + 'Node, 'Element) heap" register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData) heap" +type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" definition character_data_ptr_kinds :: "(_) heap \ (_) character_data_ptr fset" @@ -139,8 +140,8 @@ begin definition a_type_wf :: "(_) heap \ bool" where "a_type_wf h = (ElementClass.type_wf h - \ (\character_data_ptr. character_data_ptr |\| character_data_ptr_kinds h - \ get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr h \ None))" + \ (\character_data_ptr \ fset (character_data_ptr_kinds h). + get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr h \ None))" end global_interpretation l_type_wf_def\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a defines type_wf = a_type_wf . lemmas type_wf_defs = a_type_wf_def @@ -163,8 +164,7 @@ lemma get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub> \ get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr h \ None" using l_type_wf\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_axioms assms apply(simp add: type_wf_defs get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def l_type_wf\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def) - by (metis NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf bind_eq_None_conv character_data_ptr_kinds_commutes - l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def local.l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e_axioms option.distinct(1)) + by (metis assms bind.bind_lzero character_data_ptr_kinds_commutes fmember.rep_eq local.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf option.exhaust option.simps(3)) end global_interpretation l_get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_lemmas type_wf @@ -325,23 +325,26 @@ locale l_known_ptrs\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^su begin definition a_known_ptrs :: "(_) heap \ bool" where - "a_known_ptrs h = (\ptr. ptr |\| object_ptr_kinds h \ known_ptr ptr)" + "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" - by(simp add: a_known_ptrs_def) + apply(simp add: a_known_ptrs_def) + using notin_fset by fastforce lemma known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ a_known_ptrs h = a_known_ptrs h'" by(auto simp add: a_known_ptrs_def) lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" - by(auto simp add: a_known_ptrs_def) + by(simp add: a_known_ptrs_def less_eq_fset.rep_eq subsetD) +lemma known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ a_known_ptrs h \ a_known_ptrs h'" + by(simp add: a_known_ptrs_def) end global_interpretation l_known_ptrs\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a known_ptr defines known_ptrs = a_known_ptrs . lemmas known_ptrs_defs = a_known_ptrs_def lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs" - using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset + using known_ptrs_known_ptr known_ptrs_preserved known_ptrs_subset known_ptrs_new_ptr l_known_ptrs_def by blast end diff --git a/Core_DOM/classes/DocumentClass.thy b/Core_DOM/common/classes/DocumentClass.thy similarity index 96% rename from Core_DOM/classes/DocumentClass.thy rename to Core_DOM/common/classes/DocumentClass.thy index 594e014..094e216 100644 --- a/Core_DOM/classes/DocumentClass.thy +++ b/Core_DOM/common/classes/DocumentClass.thy @@ -65,6 +65,7 @@ type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'docume register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document) heap" +type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" definition document_ptr_kinds :: "(_) heap \ (_) document_ptr fset" @@ -115,7 +116,7 @@ begin definition a_type_wf :: "(_) heap \ bool" where "a_type_wf h = (CharacterDataClass.type_wf h \ - (\document_ptr. document_ptr |\| document_ptr_kinds h \ get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h \ None))" + (\document_ptr \ fset (document_ptr_kinds h). get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h \ None))" end global_interpretation l_type_wf_def\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t defines type_wf = a_type_wf . lemmas type_wf_defs = a_type_wf_def @@ -135,8 +136,7 @@ lemma get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_w shows "document_ptr |\| document_ptr_kinds h \ get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h \ None" using l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_axioms assms apply(simp add: type_wf_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) - by (metis bind_eq_None_conv document_ptr_kinds_commutes local.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf - option.distinct(1)) + by (metis document_ptr_kinds_commutes fmember.rep_eq is_none_bind is_none_simps(1) is_none_simps(2) local.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf) end global_interpretation l_get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales @@ -228,7 +228,7 @@ abbreviation definition new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_)heap \ ((_) document_ptr \ (_) heap)" where "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = - (let new_document_ptr = document_ptr.Ref (Suc (fMax (document_ptr.the_ref |`| (document_ptrs h)))) + (let new_document_ptr = document_ptr.Ref (Suc (fMax (finsert 0 (document_ptr.the_ref |`| (document_ptrs h))))) in (new_document_ptr, put new_document_ptr (create_document_obj '''' None []) h))" @@ -315,22 +315,26 @@ locale l_known_ptrs\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^su begin definition a_known_ptrs :: "(_) heap \ bool" where - "a_known_ptrs h = (\ptr. ptr |\| object_ptr_kinds h \ known_ptr ptr)" + "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" - by(simp add: a_known_ptrs_def) + apply(simp add: a_known_ptrs_def) + using notin_fset by fastforce lemma known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ a_known_ptrs h = a_known_ptrs h'" by(auto simp add: a_known_ptrs_def) lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" - by(auto simp add: a_known_ptrs_def) + by(simp add: a_known_ptrs_def less_eq_fset.rep_eq subsetD) +lemma known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ a_known_ptrs h \ a_known_ptrs h'" + by(simp add: a_known_ptrs_def) end global_interpretation l_known_ptrs\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t known_ptr defines known_ptrs = a_known_ptrs . lemmas known_ptrs_defs = a_known_ptrs_def lemma known_ptrs_is_l_known_ptrs [instances]: "l_known_ptrs known_ptr known_ptrs" - using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset by blast + using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset known_ptrs_new_ptr + by blast end diff --git a/Core_DOM/classes/NodeClass.thy b/Core_DOM/common/classes/NodeClass.thy similarity index 92% rename from Core_DOM/classes/NodeClass.thy rename to Core_DOM/common/classes/NodeClass.thy index 142c7fa..fdbbff1 100644 --- a/Core_DOM/classes/NodeClass.thy +++ b/Core_DOM/common/classes/NodeClass.thy @@ -51,6 +51,7 @@ type_synonym ('object_ptr, 'node_ptr, 'Object, 'Node) heap = "('node_ptr node_ptr + 'object_ptr, 'Node RNode_ext + 'Object) heap" register_default_tvars "('object_ptr, 'node_ptr, 'Object, 'Node) heap" +type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit) heap" definition node_ptr_kinds :: "(_) heap \ (_) node_ptr fset" @@ -89,8 +90,7 @@ begin definition a_type_wf :: "(_) heap \ bool" where "a_type_wf h = (ObjectClass.type_wf h - \ (\node_ptr. node_ptr |\| node_ptr_kinds h - \ get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h \ None))" + \ (\node_ptr \ fset( node_ptr_kinds h). get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h \ None))" end global_interpretation l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e defines type_wf = a_type_wf . lemmas type_wf_defs = a_type_wf_def @@ -110,9 +110,8 @@ lemma get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf: shows "node_ptr |\| node_ptr_kinds h \ get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h \ None" using l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e_axioms assms apply(simp add: type_wf_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) - by (metis (mono_tags, lifting) bind_eq_None_conv ffmember_filter fimage_eqI - is_node_ptr_kind_cast get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf local.l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_axioms - node_ptr_casts_commute2 node_ptr_kinds_def option.sel option.simps(3)) + by (metis bind_eq_None_conv ffmember_filter fimage_eqI fmember.rep_eq is_node_ptr_kind_cast + get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf node_ptr_casts_commute2 node_ptr_kinds_def option.sel option.simps(3)) end global_interpretation l_get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas type_wf @@ -177,21 +176,24 @@ locale l_known_ptrs\<^sub>N\<^sub>o\<^sub>d\<^sub>e = l_known_ptr known_ptr for begin definition a_known_ptrs :: "(_) heap \ bool" where - "a_known_ptrs h = (\ptr. ptr |\| object_ptr_kinds h \ known_ptr ptr)" + "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" - by(simp add: a_known_ptrs_def) - + apply(simp add: a_known_ptrs_def) + using notin_fset by fastforce lemma known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ a_known_ptrs h = a_known_ptrs h'" by(auto simp add: a_known_ptrs_def) lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" - by(auto simp add: a_known_ptrs_def) + by(simp add: a_known_ptrs_def less_eq_fset.rep_eq subsetD) +lemma known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ a_known_ptrs h \ a_known_ptrs h'" + by(simp add: a_known_ptrs_def) end global_interpretation l_known_ptrs\<^sub>N\<^sub>o\<^sub>d\<^sub>e known_ptr defines known_ptrs = a_known_ptrs . lemmas known_ptrs_defs = a_known_ptrs_def lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs" - using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset by blast + using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset known_ptrs_new_ptr + by blast lemma get_node_ptr_simp1 [simp]: "get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr (put\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr node h) = Some node" by(auto simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) diff --git a/Core_DOM/classes/ObjectClass.thy b/Core_DOM/common/classes/ObjectClass.thy similarity index 89% rename from Core_DOM/classes/ObjectClass.thy rename to Core_DOM/common/classes/ObjectClass.thy index 310c64b..7461138 100644 --- a/Core_DOM/classes/ObjectClass.thy +++ b/Core_DOM/common/classes/ObjectClass.thy @@ -45,6 +45,7 @@ register_default_tvars "'Object Object" datatype ('object_ptr, 'Object) heap = Heap (the_heap: "((_) object_ptr, (_) Object) fmap") register_default_tvars "('object_ptr, 'Object) heap" +type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit) heap" definition object_ptr_kinds :: "(_) heap \ (_) object_ptr fset" where @@ -128,27 +129,32 @@ locale l_known_ptrs = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \ ptr |\| object_ptr_kinds h \ known_ptr ptr" assumes known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ known_ptrs h = known_ptrs h'" assumes known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ known_ptrs h \ known_ptrs h'" + assumes known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ known_ptrs h \ known_ptrs h'" locale l_known_ptrs\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \ bool" begin definition a_known_ptrs :: "(_) heap \ bool" where - "a_known_ptrs h = (\ptr. ptr |\| object_ptr_kinds h \ known_ptr ptr)" + "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" - by(simp add: a_known_ptrs_def) + apply(simp add: a_known_ptrs_def) + using notin_fset by fastforce lemma known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ a_known_ptrs h = a_known_ptrs h'" by(auto simp add: a_known_ptrs_def) lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" - by(auto simp add: a_known_ptrs_def) + by(simp add: a_known_ptrs_def less_eq_fset.rep_eq subsetD) +lemma known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ a_known_ptrs h \ a_known_ptrs h'" + by(simp add: a_known_ptrs_def) end global_interpretation l_known_ptrs\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t known_ptr defines known_ptrs = a_known_ptrs . lemmas known_ptrs_defs = a_known_ptrs_def lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs" - using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset by blast + using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset known_ptrs_new_ptr + by blast lemma get_object_ptr_simp1 [simp]: "get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr object h) = Some object" @@ -188,4 +194,24 @@ lemma delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok: using assms by(auto simp add: delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def object_ptr_kinds_def split: if_splits) + +subsection \Code Generator Setup\ + +definition "create_heap xs = Heap (fmap_of_list xs)" + +code_datatype ObjectClass.heap.Heap create_heap + +lemma object_ptr_kinds_code3 [code]: + "fmlookup (the_heap (create_heap xs)) x = map_of xs x" + by(auto simp add: create_heap_def fmlookup_of_list) + +lemma object_ptr_kinds_code4 [code]: + "the_heap (create_heap xs) = fmap_of_list xs" + by(simp add: create_heap_def) + +lemma object_ptr_kinds_code5 [code]: + "the_heap (Heap x) = x" + by simp + + end diff --git a/Core_DOM/monads/BaseMonad.thy b/Core_DOM/common/monads/BaseMonad.thy similarity index 100% rename from Core_DOM/monads/BaseMonad.thy rename to Core_DOM/common/monads/BaseMonad.thy diff --git a/Core_DOM/monads/CharacterDataMonad.thy b/Core_DOM/common/monads/CharacterDataMonad.thy similarity index 94% rename from Core_DOM/monads/CharacterDataMonad.thy rename to Core_DOM/common/monads/CharacterDataMonad.thy index 9811731..b86e4c3 100644 --- a/Core_DOM/monads/CharacterDataMonad.thy +++ b/Core_DOM/common/monads/CharacterDataMonad.thy @@ -58,9 +58,8 @@ lemma character_data_ptr_kinds_M_reads: "reads (\node_ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node_ptr RObject.nothing)}) character_data_ptr_kinds_M h h'" using node_ptr_kinds_M_reads apply (simp add: reads_def node_ptr_kinds_M_defs character_data_ptr_kinds_M_defs - character_data_ptr_kinds_def preserved_def cong del: image_cong_simp) - apply (metis (mono_tags, hide_lams) node_ptr_kinds_small old.unit.exhaust preserved_def) - done + character_data_ptr_kinds_def preserved_def) + by (smt node_ptr_kinds_small preserved_def unit_all_impI) global_interpretation l_dummy defines get_M\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a = "l_get_M.a_get_M get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a" . lemma get_M_is_l_get_M: "l_get_M get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a type_wf character_data_ptr_kinds" @@ -308,8 +307,9 @@ lemma type_wf_put_ptr_not_in_heap_E: assumes "ptr |\| object_ptr_kinds h" shows "type_wf h" using assms - by(auto simp add: type_wf_defs elim!: ElementMonad.type_wf_put_ptr_not_in_heap_E + apply(auto simp add: type_wf_defs elim!: ElementMonad.type_wf_put_ptr_not_in_heap_E split: option.splits if_splits) + using assms(2) node_ptr_kinds_commutes by blast lemma type_wf_put_ptr_in_heap_E: assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)" @@ -319,14 +319,7 @@ lemma type_wf_put_ptr_in_heap_E: shows "type_wf h" using assms apply(auto simp add: type_wf_defs split: option.splits if_splits)[1] - apply(case_tac "x2 = cast character_data_ptr") - apply(auto)[1] - apply(drule_tac x=character_data_ptr in allE) - apply(simp) - apply (metis (no_types, lifting) ElementClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf assms(2) bind.bind_lunit - cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def - get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def option.exhaust_sel) - by(blast) + by (metis (no_types, lifting) ElementClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf assms(2) bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def notin_fset option.collapse) subsection\Preserving Types\ @@ -365,8 +358,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_type_typ apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs split: option.splits)[1] using ObjectMonad.type_wf_put_ptr_in_heap_E ObjectMonad.type_wf_put_ptr_not_in_heap_E apply blast - apply (metis (mono_tags, lifting) bind_eq_Some_conv get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.exhaust_sel) - by (metis (no_types, lifting) option.exhaust_sel ) + apply (metis (no_types, lifting) bind_eq_Some_conv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) + apply (metis finite_set_in) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]: @@ -391,9 +385,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_ NodeClass.type_wf_defs ElementMonad.get_M_defs split: option.splits)[1] using ObjectMonad.type_wf_put_ptr_in_heap_E ObjectMonad.type_wf_put_ptr_not_in_heap_E apply blast - apply (metis (mono_tags, lifting) ElementMonad.a_get_M_def bind_eq_Some_conv error_returns_result - get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get_heap_returns_result option.exhaust_sel option.simps(4)) - by (metis (no_types, lifting) option.exhaust_sel) + apply (metis (no_types, lifting) bind_eq_Some_conv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) + apply (metis finite_set_in) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_wf_preserved [simp]: "h \ put_M element_ptr attrs_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -413,8 +407,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_w apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs split: option.splits)[1] using ObjectMonad.type_wf_put_ptr_in_heap_E ObjectMonad.type_wf_put_ptr_not_in_heap_E apply blast - apply (metis (mono_tags, lifting) ElementMonad.a_get_M_def bind_eq_Some_conv error_returns_result get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get_heap_returns_result option.exhaust_sel option.simps(4)) - by (metis (no_types, lifting) option.exhaust_sel) + apply (metis (no_types, lifting) bind_eq_Some_conv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) + apply (metis finite_set_in) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_opt_type_wf_preserved [simp]: "h \ put_M element_ptr shadow_root_opt_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -434,8 +429,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs split: option.splits)[1] using ObjectMonad.type_wf_put_ptr_in_heap_E ObjectMonad.type_wf_put_ptr_not_in_heap_E apply blast - apply (metis (mono_tags, lifting) bind_eq_Some_conv get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) - by (metis (no_types, lifting) option.exhaust_sel) + apply (metis (no_types, lifting) bind_eq_Some_conv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) + apply (metis finite_set_in) + done lemma new_character_data_type_wf_preserved [simp]: @@ -470,8 +466,9 @@ lemma put_M\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^su NodeClass.type_wf_defs CharacterDataMonad.get_M_defs ObjectClass.a_type_wf_def split: option.splits)[1] - apply (metis (no_types, lifting) bind_eq_Some_conv get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def) - by metis + apply (metis (no_types, lifting) bind_eq_Some_conv finite_set_in get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def) + apply (metis finite_set_in) + done lemma character_data_ptr_kinds_small: assumes "\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" @@ -529,8 +526,6 @@ lemma type_wf_drop: "type_wf h \ type_wf (Heap (fmdrop ptr (the_ apply(auto simp add: type_wf_def ElementMonad.type_wf_drop l_type_wf_def\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a.a_type_wf_def)[1] using type_wf_drop - by (metis (no_types, lifting) ElementClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf character_data_ptr_kinds_commutes - fmlookup_drop get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def heap.sel - node_ptr_kinds_commutes) + by (metis (no_types, lifting) ElementClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf character_data_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def node_ptr_kinds_commutes object_ptr_kinds_code5) -end \ No newline at end of file +end diff --git a/Core_DOM/monads/DocumentMonad.thy b/Core_DOM/common/monads/DocumentMonad.thy similarity index 94% rename from Core_DOM/monads/DocumentMonad.thy rename to Core_DOM/common/monads/DocumentMonad.thy index d2d17a5..9b9958c 100644 --- a/Core_DOM/monads/DocumentMonad.thy +++ b/Core_DOM/common/monads/DocumentMonad.thy @@ -322,8 +322,7 @@ lemma type_wf_put_ptr_in_heap_E: using assms apply(auto simp add: type_wf_defs elim!: CharacterDataMonad.type_wf_put_ptr_in_heap_E split: option.splits if_splits)[1] - by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - is_document_kind_def option.collapse) + by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def is_document_kind_def notin_fset option.exhaust_sel) @@ -361,9 +360,8 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_type_typ apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - apply (metis (no_types, lifting) Option.bind_cong bind_rzero - get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.distinct(1)) - by metis + apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) + by (metis fmember.rep_eq) lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]: "h \ put_M element_ptr child_nodes_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -378,8 +376,8 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_ apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - apply (metis (no_types, lifting) Option.bind_cong bind_rzero get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.distinct(1)) - by metis + apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) + by (metis fmember.rep_eq) lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_wf_preserved [simp]: "h \ put_M element_ptr attrs_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -394,8 +392,8 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_w apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - apply (metis (no_types, lifting) Option.bind_cong bind_rzero get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.distinct(1)) - by metis + apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) + by (metis fmember.rep_eq) lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_opt_type_wf_preserved [simp]: "h \ put_M element_ptr shadow_root_opt_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -410,8 +408,8 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - apply (metis (no_types, lifting) Option.bind_cong bind_rzero get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.distinct(1)) - by metis + apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) + by (metis fmember.rep_eq) lemma new_character_data_type_wf_preserved [simp]: "h \ new_character_data \\<^sub>h h' \ type_wf h = type_wf h'" @@ -440,13 +438,11 @@ lemma put_M\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^su intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I ObjectMonad.type_wf_put_I)[1] apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + NodeClass.type_wf_defs CharacterDataMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - apply (metis (no_types, lifting) CharacterDataMonad.a_get_M_def bind_eq_None_conv - error_returns_result get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get_heap_returns_result option.exhaust_sel - option.simps(4)) - by (metis (no_types, lifting) CharacterDataMonad.a_get_M_def error_returns_result - get_heap_returns_result option.exhaust_sel option.simps(4)) + apply (metis bind.bind_lzero finite_set_in get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def option.distinct(1) option.exhaust_sel) + by (metis finite_set_in) + lemma new_document_type_wf_preserved [simp]: "h \ new_document \\<^sub>h h' \ type_wf h = type_wf h'" apply(auto simp add: new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def @@ -460,7 +456,10 @@ lemma new_document_type_wf_preserved [simp]: "h \ new_document \D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_not_in_heap) + using document_ptrs_def apply fastforce + apply (simp add: is_document_kind_def) + apply (metis Suc_n_not_le_n document_ptr.sel(1) document_ptrs_def fMax_ge ffmember_filter fimage_eqI is_document_ptr_ref) + done locale l_new_document = l_type_wf + assumes new_document_types_preserved: "h \ new_document \\<^sub>h h' \ type_wf h = type_wf h'" @@ -500,7 +499,7 @@ lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_doct NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] apply(auto simp add: get_M_defs) - by (metis (no_types, lifting) error_returns_result option.exhaust_sel option.simps(4)) + by (metis (mono_tags) error_returns_result finite_set_in option.exhaust_sel option.simps(4)) lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_document_element_type_wf_preserved [simp]: "h \ put_M document_ptr document_element_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -519,7 +518,7 @@ lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_docu NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - by (metis) + by (metis finite_set_in) lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_disconnected_nodes_type_wf_preserved [simp]: "h \ put_M document_ptr disconnected_nodes_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -538,7 +537,7 @@ lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_disc apply(auto simp add: is_document_kind_def get_M_defs type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - by (metis) + by (metis finite_set_in) lemma document_ptr_kinds_small: assumes "\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" @@ -600,6 +599,5 @@ lemma type_wf_drop: "type_wf h \ type_wf (Heap (fmdrop ptr (the_ apply(auto simp add: type_wf_defs)[1] using type_wf_drop apply blast - by (metis (mono_tags, lifting) comp_apply document_ptr_kinds_commutes ffmember_filter fmdom_filter - fmfilter_alt_defs(1) fmlookup_drop get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def heap.sel object_ptr_kinds_def) + by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf CharacterDataMonad.type_wf_drop document_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def heap.sel) end diff --git a/Core_DOM/monads/ElementMonad.thy b/Core_DOM/common/monads/ElementMonad.thy similarity index 87% rename from Core_DOM/monads/ElementMonad.thy rename to Core_DOM/common/monads/ElementMonad.thy index 59fcc71..2103139 100644 --- a/Core_DOM/monads/ElementMonad.thy +++ b/Core_DOM/common/monads/ElementMonad.thy @@ -32,7 +32,7 @@ text\In this theory, we introduce the monadic method setup for the Element theory ElementMonad imports NodeMonad - "../classes/ElementClass" + "ElementClass" begin type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, @@ -299,8 +299,9 @@ lemma type_wf_put_ptr_not_in_heap_E: assumes "ptr |\| object_ptr_kinds h" shows "type_wf h" using assms - by(auto simp add: type_wf_defs elim!: NodeMonad.type_wf_put_ptr_not_in_heap_E - split: option.splits if_splits) + apply(auto simp add: type_wf_defs elim!: NodeMonad.type_wf_put_ptr_not_in_heap_E + split: option.splits if_splits)[1] + using assms(2) node_ptr_kinds_commutes by blast lemma type_wf_put_ptr_in_heap_E: assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)" @@ -310,12 +311,9 @@ lemma type_wf_put_ptr_in_heap_E: shows "type_wf h" using assms apply(auto simp add: type_wf_defs split: option.splits if_splits)[1] - apply(case_tac "x2 = cast element_ptr") - apply(drule_tac x=element_ptr in allE) - apply(auto)[1] - apply(metis (no_types, lifting) NodeClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf assms(2) bind.bind_lunit - cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def option.exhaust_sel) - by(auto) + by (metis (no_types, lifting) NodeClass.l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas_axioms assms(2) bind.bind_lunit + cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf option.collapse) subsection\Preserving Types\ @@ -324,13 +322,14 @@ lemma new_element_type_wf_preserved [simp]: "h \ new_element \E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: prod.splits if_splits elim!: bind_returns_heap_E)[1] - apply (metis element_ptr_kinds_commutes element_ptrs_def fempty_iff ffmember_filter + apply (metis element_ptr_kinds_commutes element_ptrs_def fempty_iff ffmember_filter finite_set_in is_element_ptr_ref) - using element_ptrs_def apply fastforce - apply (metis (mono_tags, hide_lams) Suc_n_not_le_n element_ptr.sel(1) element_ptr_kinds_commutes - element_ptrs_def fMax_ge ffmember_filter fimageI is_element_ptr_ref) - by (metis (no_types, lifting) fMax_finsert fempty_iff fimage_is_fempty max_0L new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_not_in_heap) + apply (metis element_ptrs_def fempty_iff ffmember_filter finite_set_in is_element_ptr_ref) + apply (metis (no_types, lifting) Suc_n_not_le_n element_ptr.sel(1) element_ptr_kinds_commutes + element_ptrs_def fMax_ge ffmember_filter fimage_eqI is_element_ptr_ref notin_fset) + apply (metis (no_types, lifting) Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def + fMax_ge ffmember_filter fimage_eqI finite_set_in is_element_ptr_ref) + done locale l_new_element = l_type_wf + assumes new_element_types_preserved: "h \ new_element \\<^sub>h h' \ type_wf h = type_wf h'" @@ -345,12 +344,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_type_typ Let_def put_M_defs get_M_defs put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: prod.splits option.splits Option.bind_splits elim!: bind_returns_heap_E)[1] - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - by (metis bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv) - + apply (metis finite_set_in option.inject) + apply (metis cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in option.sel) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]: "h \ put_M element_ptr child_nodes_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -358,11 +354,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_ Let_def put_M_defs get_M_defs put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: prod.splits option.splits Option.bind_splits elim!: bind_returns_heap_E)[1] - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - by (metis bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv) + apply (metis finite_set_in option.inject) + apply (metis cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in option.sel) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_wf_preserved [simp]: "h \ put_M element_ptr attrs_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -370,11 +364,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_w put_M_defs get_M_defs put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: prod.splits option.splits Option.bind_splits elim!: bind_returns_heap_E)[1] - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - by (metis bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv) + apply (metis finite_set_in option.inject) + apply (metis cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in option.sel) + done lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_opt_type_wf_preserved [simp]: "h \ put_M element_ptr shadow_root_opt_update v \\<^sub>h h' \ type_wf h = type_wf h'" @@ -382,11 +374,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ Let_def put_M_defs get_M_defs put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: prod.splits option.splits Option.bind_splits elim!: bind_returns_heap_E)[1] - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - apply (metis option.distinct(1)) - apply (metis bind.bind_lunit cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none) - by (metis bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv) + apply (metis finite_set_in option.inject) + apply (metis cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in option.sel) + done lemma put_M_pointers_preserved: assumes "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h'" @@ -447,11 +437,9 @@ lemma type_wf_drop: "type_wf h \ type_wf (Heap (fmdrop ptr (the_ apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs node_ptr_kinds_def object_ptr_kinds_def is_node_ptr_kind_def get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def)[1] - apply (metis (mono_tags, lifting) comp_apply ffmember_filter fimage_eqI - is_node_ptr_kind_cast node_ptr_casts_commute2 option.sel) - apply (metis (no_types, lifting) comp_apply element_ptr_kinds_commutes ffmember_filter - fmdom_filter fmfilter_alt_defs(1) heap.sel node_ptr_kinds_commutes object_ptr_kinds_def) - by (metis comp_eq_dest_lhs element_ptr_kinds_commutes fmdom_notI fmdrop_lookup heap.sel - node_ptr_kinds_commutes object_ptr_kinds_def) + apply (metis (no_types, lifting) element_ptr_kinds_commutes finite_set_in fmdom_notD fmdom_notI + fmlookup_drop heap.sel node_ptr_kinds_commutes o_apply object_ptr_kinds_def) + by (metis element_ptr_kinds_commutes fmdom_notI fmdrop_lookup heap.sel node_ptr_kinds_commutes + o_apply object_ptr_kinds_def) end diff --git a/Core_DOM/monads/NodeMonad.thy b/Core_DOM/common/monads/NodeMonad.thy similarity index 97% rename from Core_DOM/monads/NodeMonad.thy rename to Core_DOM/common/monads/NodeMonad.thy index b669f1d..b17a231 100644 --- a/Core_DOM/monads/NodeMonad.thy +++ b/Core_DOM/common/monads/NodeMonad.thy @@ -76,9 +76,8 @@ lemma node_ptr_kinds_M_reads: "reads (\object_ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing)}) node_ptr_kinds_M h h'" using object_ptr_kinds_M_reads apply (simp add: reads_def node_ptr_kinds_M_defs node_ptr_kinds_def - object_ptr_kinds_M_reads preserved_def cong del: image_cong_simp) - apply (metis (mono_tags, hide_lams) object_ptr_kinds_preserved_small old.unit.exhaust preserved_def) - done + object_ptr_kinds_M_reads preserved_def) + by (smt object_ptr_kinds_preserved_small preserved_def unit_all_impI) global_interpretation l_put_M type_wf node_ptr_kinds get\<^sub>N\<^sub>o\<^sub>d\<^sub>e put\<^sub>N\<^sub>o\<^sub>d\<^sub>e rewrites "a_get_M = get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e" @@ -167,7 +166,7 @@ lemma type_wf_put_ptr_in_heap_E: shows "type_wf h" using assms apply(auto simp add: type_wf_defs split: option.splits if_splits) - by (metis ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def is_node_kind_def option.collapse) + by (metis ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit finite_set_in get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def is_node_kind_def option.exhaust_sel) subsection\Preserving Types\ @@ -195,7 +194,8 @@ lemma type_wf_preserved_small: using type_wf_preserved allI[OF assms(2), of id, simplified] apply(auto simp add: type_wf_defs) apply(auto simp add: preserved_def get_M_defs node_ptr_kinds_small[OF assms(1)] - split: option.splits, force)[1] + split: option.splits)[1] + apply (metis notin_fset option.simps(3)) by(auto simp add: preserved_def get_M_defs node_ptr_kinds_small[OF assms(1)] split: option.splits, force)[1] diff --git a/Core_DOM/monads/ObjectMonad.thy b/Core_DOM/common/monads/ObjectMonad.thy similarity index 96% rename from Core_DOM/monads/ObjectMonad.thy rename to Core_DOM/common/monads/ObjectMonad.thy index 038bf37..69c3a86 100644 --- a/Core_DOM/monads/ObjectMonad.thy +++ b/Core_DOM/common/monads/ObjectMonad.thy @@ -244,4 +244,15 @@ proof - using object_ptr_kinds_preserved_small by blast qed + +lemma reads_writes_preserved2: + assumes "writes SW setter h h'" + assumes "h \ setter \\<^sub>h h'" + assumes "\h h' x. \w \ SW. h \ w \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr getter) h h'" + shows "preserved (get_M ptr getter) h h'" + apply(clarsimp simp add: preserved_def) + using reads_singleton assms(1) assms(2) + apply(rule reads_writes_preserved) + using assms(3) + by(auto simp add: preserved_def) end diff --git a/Core_DOM/pointers/CharacterDataPointer.thy b/Core_DOM/common/pointers/CharacterDataPointer.thy similarity index 100% rename from Core_DOM/pointers/CharacterDataPointer.thy rename to Core_DOM/common/pointers/CharacterDataPointer.thy diff --git a/Core_DOM/pointers/DocumentPointer.thy b/Core_DOM/common/pointers/DocumentPointer.thy similarity index 100% rename from Core_DOM/pointers/DocumentPointer.thy rename to Core_DOM/common/pointers/DocumentPointer.thy diff --git a/Core_DOM/pointers/ElementPointer.thy b/Core_DOM/common/pointers/ElementPointer.thy similarity index 100% rename from Core_DOM/pointers/ElementPointer.thy rename to Core_DOM/common/pointers/ElementPointer.thy diff --git a/Core_DOM/pointers/NodePointer.thy b/Core_DOM/common/pointers/NodePointer.thy similarity index 100% rename from Core_DOM/pointers/NodePointer.thy rename to Core_DOM/common/pointers/NodePointer.thy diff --git a/Core_DOM/pointers/ObjectPointer.thy b/Core_DOM/common/pointers/ObjectPointer.thy similarity index 100% rename from Core_DOM/pointers/ObjectPointer.thy rename to Core_DOM/common/pointers/ObjectPointer.thy diff --git a/Core_DOM/pointers/Ref.thy b/Core_DOM/common/pointers/Ref.thy similarity index 100% rename from Core_DOM/pointers/Ref.thy rename to Core_DOM/common/pointers/Ref.thy diff --git a/Core_DOM/preliminaries/Heap_Error_Monad.thy b/Core_DOM/common/preliminaries/Heap_Error_Monad.thy similarity index 96% rename from Core_DOM/preliminaries/Heap_Error_Monad.thy rename to Core_DOM/common/preliminaries/Heap_Error_Monad.thy index f713b04..5a4a0b4 100644 --- a/Core_DOM/preliminaries/Heap_Error_Monad.thy +++ b/Core_DOM/common/preliminaries/Heap_Error_Monad.thy @@ -79,9 +79,28 @@ definition where "returns_heap h p h' \ (case h \ p of Inr (_ , h'') \ h' = h'' | Inl _ \ False)" +fun select_heap ("|(_)|\<^sub>h") + where + "select_heap (Inr ( _, h)) = h" + | "select_heap (Inl _) = undefined" + lemma returns_heap_eq [elim]: "h \ f \\<^sub>h h' \ h \ f \\<^sub>h h'' \ h' = h''" by(auto simp add: returns_heap_def split: sum.splits) +definition + returns_result_heap :: "'heap \ ('heap, 'e, 'result) prog \ 'result \ 'heap \ bool" + ("((_)/ \ (_)/ \\<^sub>r (_) \\<^sub>h (_))" [60, 35, 61, 62] 65) + where + "returns_result_heap h p r h' \ h \ p \\<^sub>r r \ h \ p \\<^sub>h h'" + +lemma return_result_heap_code [code]: "returns_result_heap h p r h' \ (case h \ p of Inr (r', h'') \ r = r' \ h' = h'' | Inl _ \ False)" + by(auto simp add: returns_result_heap_def returns_result_def returns_heap_def split: sum.splits) + +fun select_result_heap ("|(_)|\<^sub>r\<^sub>h") + where + "select_result_heap (Inr (r, h)) = (r, h)" + | "select_result_heap (Inl _) = undefined" + definition returns_error :: "'heap \ ('heap, 'e, 'result) prog \ 'e \ bool" ("((_)/ \ (_)/ \\<^sub>e (_))" [60, 35, 61] 65) @@ -711,6 +730,11 @@ definition preserved :: "('heap, 'e, 'result) prog \ 'heap \ (\x. h \ f \\<^sub>r x \ h' \ f \\<^sub>r x)" +lemma preserved_code [code]: "preserved f h h' = (((h \ ok f) \ (h' \ ok f) \ |h \ f|\<^sub>r = |h' \ f|\<^sub>r) \ ((\h \ ok f) \ (\h' \ ok f)))" + apply(auto simp add: preserved_def)[1] + apply (meson is_OK_returns_result_E is_OK_returns_result_I)+ + done + lemma reflp_preserved_f [simp]: "reflp (preserved f)" by(auto simp add: preserved_def reflp_def) lemma transp_preserved_f [simp]: "transp (preserved f)" diff --git a/Core_DOM/preliminaries/Hiding_Type_Variables.thy b/Core_DOM/common/preliminaries/Hiding_Type_Variables.thy similarity index 100% rename from Core_DOM/preliminaries/Hiding_Type_Variables.thy rename to Core_DOM/common/preliminaries/Hiding_Type_Variables.thy diff --git a/Core_DOM/common/preliminaries/Testing_Utils.thy b/Core_DOM/common/preliminaries/Testing_Utils.thy new file mode 100644 index 0000000..a8811e7 --- /dev/null +++ b/Core_DOM/common/preliminaries/Testing_Utils.thy @@ -0,0 +1,92 @@ +(*********************************************************************************** + * Copyright (c) 2016-2018 The University of Sheffield, UK + * + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * * Redistributions of source code must retain the above copyright notice, this + * list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * SPDX-License-Identifier: BSD-2-Clause + ***********************************************************************************) + +theory Testing_Utils + imports Main +begin +ML \ +val _ = Theory.setup + (Method.setup @{binding timed_code_simp} + (Scan.succeed (SIMPLE_METHOD' o (CHANGED_PROP oo (fn a => fn b => fn tac => + let + val start = Time.now (); + val result = Code_Simp.dynamic_tac a b tac; + val t = Time.now() - start; + in + (if length (Seq.list_of result) > 0 then Output.information ("Took " ^ (Time.toString t)) else ()); + result + end)))) + "timed simplification with code equations"); + +val _ = Theory.setup + (Method.setup @{binding timed_eval} + (Scan.succeed (SIMPLE_METHOD' o (fn a => fn b => fn tac => + let + val eval = CONVERSION (Conv.params_conv ~1 (K (Conv.concl_conv ~1 (Code_Runtime.dynamic_holds_conv a))) a) THEN' + resolve_tac a [TrueI]; + val start = Time.now (); + val result = eval b tac + val t = Time.now() - start; + in + (if length (Seq.list_of result) > 0 then Output.information ("Took " ^ (Time.toString t)) else ()); + result + end))) + "timed evaluation"); + +val _ = Theory.setup + (Method.setup @{binding timed_eval_and_code_simp} + (Scan.succeed (SIMPLE_METHOD' o (fn a => fn b => fn tac => + let + val eval = CONVERSION (Conv.params_conv ~1 (K (Conv.concl_conv ~1 (Code_Runtime.dynamic_holds_conv a))) a) THEN' + resolve_tac a [TrueI]; + val start = Time.now (); + val result = eval b tac + val t = Time.now() - start; + + val start2 = Time.now (); + val result2_opt = + Timeout.apply (seconds 600.0) (fn _ => SOME (Code_Simp.dynamic_tac a b tac)) () + handle Timeout.TIMEOUT _ => NONE; + val t2 = Time.now() - start2; + in + if length (Seq.list_of result) > 0 then (Output.information ("eval took " ^ (Time.toString t)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t ^ ",")) else (); + (case result2_opt of + SOME result2 => + (if length (Seq.list_of result2) > 0 then (Output.information ("code_simp took " ^ (Time.toString t2)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t2 ^ "\n")) else ()) + | NONE => (Output.information "code_simp timed out after 600s"; File.append (Path.explode "/tmp/isabellebench") (">600.000\n"))); + result + end))) + "timed evaluation and simplification with code equations with file output"); +\ + +(* To run the DOM test cases with timing information output, simply replace the use *) +(* of "eval" with either "timed_code_simp", "timed_eval", or, to run both and write the results *) +(* to /tmp/isabellebench, "timed_eval_and_code_simp". *) + +end diff --git a/Core_DOM/tests/Core_DOM_BaseTest.thy b/Core_DOM/common/tests/Core_DOM_BaseTest.thy similarity index 93% rename from Core_DOM/tests/Core_DOM_BaseTest.thy rename to Core_DOM/common/tests/Core_DOM_BaseTest.thy index 19839f4..62f5703 100644 --- a/Core_DOM/tests/Core_DOM_BaseTest.thy +++ b/Core_DOM/common/tests/Core_DOM_BaseTest.thy @@ -79,39 +79,6 @@ definition removeWhiteSpaceOnlyTextNodes :: "((_) object_ptr option) \create\_heap\ - -(* We use this construction because partially applied functions such as "map_of xs" don't play - well together with the code generator. *) -definition "create_heap xs = Heap (fmap_of_list xs)" - -code_datatype ObjectClass.heap.Heap create_heap - -lemma object_ptr_kinds_code1 [code]: - "object_ptr_kinds (Heap (fmap_of_list xs)) = object_ptr_kinds (create_heap xs)" - by(simp add: create_heap_def) - -lemma object_ptr_kinds_code2 [code]: - "object_ptr_kinds (create_heap xs) = fset_of_list (map fst xs)" - by (simp add: object_ptr_kinds_def create_heap_def dom_map_of_conv_image_fst) - -lemma object_ptr_kinds_code3 [code]: - "fmlookup (the_heap (create_heap xs)) x = map_of xs x" - by(auto simp add: create_heap_def fmlookup_of_list) - -lemma object_ptr_kinds_code4 [code]: - "the_heap (create_heap xs) = fmap_of_list xs" - by(simp add: create_heap_def) - -lemma object_ptr_kinds_code5 [code]: - "the_heap (Heap x) = x" - by simp - -lemma object_ptr_kinds_code6 [code]: - "noop = return ()" - by(simp add: noop_def) - - subsection \Making the functions under test compatible with untyped languages such as JavaScript\ fun set_attribute_with_null :: "((_) object_ptr option) \ attr_key \ attr_value \ (_, unit) dom_prog" diff --git a/Core_DOM/tests/Document-adoptNode.html b/Core_DOM/common/tests/Document-adoptNode.html similarity index 100% rename from Core_DOM/tests/Document-adoptNode.html rename to Core_DOM/common/tests/Document-adoptNode.html diff --git a/Core_DOM/tests/Document-getElementById.html b/Core_DOM/common/tests/Document-getElementById.html similarity index 100% rename from Core_DOM/tests/Document-getElementById.html rename to Core_DOM/common/tests/Document-getElementById.html diff --git a/Core_DOM/tests/Document_adoptNode.thy b/Core_DOM/common/tests/Document_adoptNode.thy similarity index 82% rename from Core_DOM/tests/Document_adoptNode.thy rename to Core_DOM/common/tests/Document_adoptNode.thy index 4adb19b..652dccb 100644 --- a/Core_DOM/tests/Document_adoptNode.thy +++ b/Core_DOM/common/tests/Document_adoptNode.thy @@ -1,5 +1,5 @@ (*********************************************************************************** - * Copyright (c) 2016-2018 The University of Sheffield, UK + * Copyright (c) 2016-2019 The University of Sheffield, UK * * All rights reserved. * @@ -27,15 +27,17 @@ * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) -section\Testing adoptNode\ -text\This theory contains the test cases for adoptNode.\ +(* This file is automatically generated, please do not modify! *) + +section\Testing Document\_adoptNode\ +text\This theory contains the test cases for Document\_adoptNode.\ theory Document_adoptNode imports "Core_DOM_BaseTest" begin -definition Document_adoptNode_heap :: "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" where +definition Document_adoptNode_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where "Document_adoptNode_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])), (cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 8)] fmempty None)), (cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6), cast (element_ptr.Ref 7)] fmempty None)), @@ -52,30 +54,30 @@ definition Document_adoptNode_heap :: "(unit, unit, unit, unit, unit, unit, unit (cast (element_ptr.Ref 11), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 3)] fmempty None)), (cast (character_data_ptr.Ref 3), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]" -definition document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "document = Some (cast (document_ptr.Ref 1))" +definition Document_adoptNode_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Document_adoptNode_document = Some (cast (document_ptr.Ref 1))" text \"Adopting an Element called 'x<' should work."\ lemma "test (do { - tmp0 \ document . getElementsByTagName(''x<''); + tmp0 \ Document_adoptNode_document . getElementsByTagName(''x<''); y \ return (tmp0 ! 0); child \ y . firstChild; tmp1 \ y . parentNode; - tmp2 \ document . body; + tmp2 \ Document_adoptNode_document . body; assert_equals(tmp1, tmp2); tmp3 \ y . ownerDocument; - assert_equals(tmp3, document); - tmp4 \ document . adoptNode(y); + assert_equals(tmp3, Document_adoptNode_document); + tmp4 \ Document_adoptNode_document . adoptNode(y); assert_equals(tmp4, y); tmp5 \ y . parentNode; assert_equals(tmp5, None); tmp6 \ y . firstChild; assert_equals(tmp6, child); tmp7 \ y . ownerDocument; - assert_equals(tmp7, document); + assert_equals(tmp7, Document_adoptNode_document); tmp8 \ child . ownerDocument; - assert_equals(tmp8, document); + assert_equals(tmp8, Document_adoptNode_document); doc \ createDocument(None, None, None); tmp9 \ doc . adoptNode(y); assert_equals(tmp9, y); @@ -94,8 +96,8 @@ lemma "test (do { text \"Adopting an Element called ':good:times:' should work."\ lemma "test (do { - x \ document . createElement('':good:times:''); - tmp0 \ document . adoptNode(x); + x \ Document_adoptNode_document . createElement('':good:times:''); + tmp0 \ Document_adoptNode_document . adoptNode(x); assert_equals(tmp0, x); doc \ createDocument(None, None, None); tmp1 \ doc . adoptNode(x); diff --git a/Core_DOM/tests/Document_getElementById.thy b/Core_DOM/common/tests/Document_getElementById.thy similarity index 68% rename from Core_DOM/tests/Document_getElementById.thy rename to Core_DOM/common/tests/Document_getElementById.thy index 9ece29a..6c5b481 100644 --- a/Core_DOM/tests/Document_getElementById.thy +++ b/Core_DOM/common/tests/Document_getElementById.thy @@ -1,5 +1,5 @@ (*********************************************************************************** - * Copyright (c) 2016-2018 The University of Sheffield, UK + * Copyright (c) 2016-2019 The University of Sheffield, UK * * All rights reserved. * @@ -27,15 +27,17 @@ * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) -section\Testing getElementById\ -text\This theory contains the test cases for getElementById.\ +(* This file is automatically generated, please do not modify! *) + +section\Testing Document\_getElementById\ +text\This theory contains the test cases for Document\_getElementById.\ theory Document_getElementById imports "Core_DOM_BaseTest" begin -definition Document_getElementById_heap :: "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" where +definition Document_getElementById_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where "Document_getElementById_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])), (cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 9)] fmempty None)), (cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6), cast (element_ptr.Ref 7), cast (element_ptr.Ref 8)] fmempty None)), @@ -60,23 +62,23 @@ definition Document_getElementById_heap :: "(unit, unit, unit, unit, unit, unit, (cast (element_ptr.Ref 19), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 3)] fmempty None)), (cast (character_data_ptr.Ref 3), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]" -definition document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "document = Some (cast (document_ptr.Ref 1))" +definition Document_getElementById_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Document_getElementById_document = Some (cast (document_ptr.Ref 1))" text \"Document.getElementById with a script-inserted element"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test2''; - test \ document . createElement(''div''); + test \ Document_getElementById_document . createElement(''div''); test . setAttribute(''id'', TEST_ID); gBody . appendChild(test); - result \ document . getElementById(TEST_ID); + result \ Document_getElementById_document . getElementById(TEST_ID); assert_not_equals(result, None, ''should not be null.''); tmp0 \ result . tagName; assert_equals(tmp0, ''div'', ''should have appended element's tag name''); gBody . removeChild(test); - removed \ document . getElementById(TEST_ID); + removed \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(removed, None, ''should not get removed element.'') }) Document_getElementById_heap" by eval @@ -85,19 +87,19 @@ lemma "test (do { text \"update `id` attribute via setAttribute/removeAttribute"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test3''; - test \ document . createElement(''div''); + test \ Document_getElementById_document . createElement(''div''); test . setAttribute(''id'', TEST_ID); gBody . appendChild(test); UPDATED_ID \ return ''test3-updated''; test . setAttribute(''id'', UPDATED_ID); - e \ document . getElementById(UPDATED_ID); + e \ Document_getElementById_document . getElementById(UPDATED_ID); assert_equals(e, test, ''should get the element with id.''); - old \ document . getElementById(TEST_ID); + old \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(old, None, ''shouldn't get the element by the old id.''); test . removeAttribute(''id''); - e2 \ document . getElementById(UPDATED_ID); + e2 \ Document_getElementById_document . getElementById(UPDATED_ID); assert_equals(e2, None, ''should return null when the passed id is none in document.'') }) Document_getElementById_heap" by eval @@ -107,13 +109,13 @@ text \"Ensure that the id attribute only affects elements present in a doc lemma "test (do { TEST_ID \ return ''test4-should-not-exist''; - e \ document . createElement(''div''); + e \ Document_getElementById_document . createElement(''div''); e . setAttribute(''id'', TEST_ID); - tmp0 \ document . getElementById(TEST_ID); + tmp0 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(tmp0, None, ''should be null''); - tmp1 \ document . body; + tmp1 \ Document_getElementById_document . body; tmp1 . appendChild(e); - tmp2 \ document . getElementById(TEST_ID); + tmp2 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(tmp2, e, ''should be the appended element'') }) Document_getElementById_heap" by eval @@ -122,23 +124,23 @@ lemma "test (do { text \"in tree order, within the context object's tree"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test5''; - target \ document . getElementById(TEST_ID); + target \ Document_getElementById_document . getElementById(TEST_ID); assert_not_equals(target, None, ''should not be null''); tmp0 \ target . getAttribute(''data-name''); assert_equals(tmp0, ''1st'', ''should return the 1st''); - element4 \ document . createElement(''div''); + element4 \ Document_getElementById_document . createElement(''div''); element4 . setAttribute(''id'', TEST_ID); element4 . setAttribute(''data-name'', ''4th''); gBody . appendChild(element4); - target2 \ document . getElementById(TEST_ID); + target2 \ Document_getElementById_document . getElementById(TEST_ID); assert_not_equals(target2, None, ''should not be null''); tmp1 \ target2 . getAttribute(''data-name''); assert_equals(tmp1, ''1st'', ''should be the 1st''); tmp2 \ target2 . parentNode; tmp2 . removeChild(target2); - target3 \ document . getElementById(TEST_ID); + target3 \ Document_getElementById_document . getElementById(TEST_ID); assert_not_equals(target3, None, ''should not be null''); tmp3 \ target3 . getAttribute(''data-name''); assert_equals(tmp3, ''4th'', ''should be the 4th'') @@ -146,17 +148,15 @@ lemma "test (do { by eval -text \"Modern browsers optimize this method with using internal id cache. - This test checks that their optimization should effect only append to - `Document`, not append to `Node`."\ +text \"Modern browsers optimize this method with using internal id cache. This test checks that their optimization should effect only append to `Document`, not append to `Node`."\ lemma "test (do { TEST_ID \ return ''test6''; - s \ document . createElement(''div''); + s \ Document_getElementById_document . createElement(''div''); s . setAttribute(''id'', TEST_ID); - tmp0 \ document . createElement(''div''); + tmp0 \ Document_getElementById_document . createElement(''div''); tmp0 . appendChild(s); - tmp1 \ document . getElementById(TEST_ID); + tmp1 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(tmp1, None, ''should be null'') }) Document_getElementById_heap" by eval @@ -165,17 +165,17 @@ lemma "test (do { text \"changing attribute's value via `Attr` gotten from `Element.attribute`."\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test7''; - element \ document . createElement(''div''); + element \ Document_getElementById_document . createElement(''div''); element . setAttribute(''id'', TEST_ID); gBody . appendChild(element); - target \ document . getElementById(TEST_ID); + target \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(target, element, ''should return the element before changing the value''); element . setAttribute(''id'', (TEST_ID @ ''-updated'')); - target2 \ document . getElementById(TEST_ID); + target2 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(target2, None, ''should return null after updated id via Attr.value''); - target3 \ document . getElementById((TEST_ID @ ''-updated'')); + target3 \ Document_getElementById_document . getElementById((TEST_ID @ ''-updated'')); assert_equals(target3, element, ''should be equal to the updated element.'') }) Document_getElementById_heap" by eval @@ -184,19 +184,19 @@ lemma "test (do { text \"update `id` attribute via element.id"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test12''; - test \ document . createElement(''div''); + test \ Document_getElementById_document . createElement(''div''); test . setAttribute(''id'', TEST_ID); gBody . appendChild(test); UPDATED_ID \ return (TEST_ID @ ''-updated''); test . setAttribute(''id'', UPDATED_ID); - e \ document . getElementById(UPDATED_ID); + e \ Document_getElementById_document . getElementById(UPDATED_ID); assert_equals(e, test, ''should get the element with id.''); - old \ document . getElementById(TEST_ID); + old \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(old, None, ''shouldn't get the element by the old id.''); test . setAttribute(''id'', ''''); - e2 \ document . getElementById(UPDATED_ID); + e2 \ Document_getElementById_document . getElementById(UPDATED_ID); assert_equals(e2, None, ''should return null when the passed id is none in document.'') }) Document_getElementById_heap" by eval @@ -205,33 +205,33 @@ lemma "test (do { text \"where insertion order and tree order don't match"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test13''; - container \ document . createElement(''div''); + container \ Document_getElementById_document . createElement(''div''); container . setAttribute(''id'', (TEST_ID @ ''-fixture'')); gBody . appendChild(container); - element1 \ document . createElement(''div''); + element1 \ Document_getElementById_document . createElement(''div''); element1 . setAttribute(''id'', TEST_ID); - element2 \ document . createElement(''div''); + element2 \ Document_getElementById_document . createElement(''div''); element2 . setAttribute(''id'', TEST_ID); - element3 \ document . createElement(''div''); + element3 \ Document_getElementById_document . createElement(''div''); element3 . setAttribute(''id'', TEST_ID); - element4 \ document . createElement(''div''); + element4 \ Document_getElementById_document . createElement(''div''); element4 . setAttribute(''id'', TEST_ID); container . appendChild(element2); container . appendChild(element4); container . insertBefore(element3, element4); container . insertBefore(element1, element2); - test \ document . getElementById(TEST_ID); + test \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(test, element1, ''should return 1st element''); container . removeChild(element1); - test \ document . getElementById(TEST_ID); + test \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(test, element2, ''should return 2nd element''); container . removeChild(element2); - test \ document . getElementById(TEST_ID); + test \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(test, element3, ''should return 3rd element''); container . removeChild(element3); - test \ document . getElementById(TEST_ID); + test \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(test, element4, ''should return 4th element''); container . removeChild(element4) }) Document_getElementById_heap" @@ -241,16 +241,16 @@ lemma "test (do { text \"Inserting an id by inserting its parent node"\ lemma "test (do { - gBody \ document . body; + gBody \ Document_getElementById_document . body; TEST_ID \ return ''test14''; - a \ document . createElement(''a''); - b \ document . createElement(''b''); + a \ Document_getElementById_document . createElement(''a''); + b \ Document_getElementById_document . createElement(''b''); a . appendChild(b); b . setAttribute(''id'', TEST_ID); - tmp0 \ document . getElementById(TEST_ID); + tmp0 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(tmp0, None); gBody . appendChild(a); - tmp1 \ document . getElementById(TEST_ID); + tmp1 \ Document_getElementById_document . getElementById(TEST_ID); assert_equals(tmp1, b) }) Document_getElementById_heap" by eval @@ -260,15 +260,15 @@ text \"Document.getElementById must not return nodes not present in docume lemma "test (do { TEST_ID \ return ''test15''; - outer \ document . getElementById(''outer''); - middle \ document . getElementById(''middle''); - inner \ document . getElementById(''inner''); - tmp0 \ document . getElementById(''middle''); + outer \ Document_getElementById_document . getElementById(''outer''); + middle \ Document_getElementById_document . getElementById(''middle''); + inner \ Document_getElementById_document . getElementById(''inner''); + tmp0 \ Document_getElementById_document . getElementById(''middle''); outer . removeChild(tmp0); - new_el \ document . createElement(''h1''); + new_el \ Document_getElementById_document . createElement(''h1''); new_el . setAttribute(''id'', ''heading''); inner . appendChild(new_el); - tmp1 \ document . getElementById(''heading''); + tmp1 \ Document_getElementById_document . getElementById(''heading''); assert_equals(tmp1, None) }) Document_getElementById_heap" by eval diff --git a/Core_DOM/tests/Node-insertBefore.html b/Core_DOM/common/tests/Node-insertBefore.html similarity index 100% rename from Core_DOM/tests/Node-insertBefore.html rename to Core_DOM/common/tests/Node-insertBefore.html diff --git a/Core_DOM/tests/Node-removeChild.html b/Core_DOM/common/tests/Node-removeChild.html similarity index 100% rename from Core_DOM/tests/Node-removeChild.html rename to Core_DOM/common/tests/Node-removeChild.html diff --git a/Core_DOM/tests/Node_insertBefore.thy b/Core_DOM/common/tests/Node_insertBefore.thy similarity index 77% rename from Core_DOM/tests/Node_insertBefore.thy rename to Core_DOM/common/tests/Node_insertBefore.thy index 48d1b19..5ebf2a7 100644 --- a/Core_DOM/tests/Node_insertBefore.thy +++ b/Core_DOM/common/tests/Node_insertBefore.thy @@ -1,5 +1,5 @@ (*********************************************************************************** - * Copyright (c) 2016-2018 The University of Sheffield, UK + * Copyright (c) 2016-2019 The University of Sheffield, UK * * All rights reserved. * @@ -27,15 +27,17 @@ * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) -section\Testing insertBefore\ -text\This theory contains the test cases for insertBefore.\ +(* This file is automatically generated, please do not modify! *) + +section\Testing Node\_insertBefore\ +text\This theory contains the test cases for Node\_insertBefore.\ theory Node_insertBefore imports "Core_DOM_BaseTest" begin -definition Node_insertBefore_heap :: "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" where +definition Node_insertBefore_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where "Node_insertBefore_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])), (cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 6)] fmempty None)), (cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5)] fmempty None)), @@ -48,14 +50,14 @@ definition Node_insertBefore_heap :: "(unit, unit, unit, unit, unit, unit, unit, (cast (element_ptr.Ref 8), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 2)] fmempty None)), (cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]" -definition document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "document = Some (cast (document_ptr.Ref 1))" +definition Node_insertBefore_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Node_insertBefore_document = Some (cast (document_ptr.Ref 1))" text \"Calling insertBefore an a leaf node Text must throw HIERARCHY\_REQUEST\_ERR."\ lemma "test (do { - node \ document . createTextNode(''Foo''); - tmp0 \ document . createTextNode(''fail''); + node \ Node_insertBefore_document . createTextNode(''Foo''); + tmp0 \ Node_insertBefore_document . createTextNode(''fail''); assert_throws(HierarchyRequestError, node . insertBefore(tmp0, None)) }) Node_insertBefore_heap" by eval @@ -64,13 +66,13 @@ lemma "test (do { text \"Calling insertBefore with an inclusive ancestor of the context object must throw HIERARCHY\_REQUEST\_ERR."\ lemma "test (do { - tmp1 \ document . body; - tmp2 \ document . getElementById(''log''); - tmp0 \ document . body; + tmp1 \ Node_insertBefore_document . body; + tmp2 \ Node_insertBefore_document . getElementById(''log''); + tmp0 \ Node_insertBefore_document . body; assert_throws(HierarchyRequestError, tmp0 . insertBefore(tmp1, tmp2)); - tmp4 \ document . documentElement; - tmp5 \ document . getElementById(''log''); - tmp3 \ document . body; + tmp4 \ Node_insertBefore_document . documentElement; + tmp5 \ Node_insertBefore_document . getElementById(''log''); + tmp3 \ Node_insertBefore_document . body; assert_throws(HierarchyRequestError, tmp3 . insertBefore(tmp4, tmp5)) }) Node_insertBefore_heap" by eval @@ -79,9 +81,9 @@ lemma "test (do { text \"Calling insertBefore with a reference child whose parent is not the context node must throw a NotFoundError."\ lemma "test (do { - a \ document . createElement(''div''); - b \ document . createElement(''div''); - c \ document . createElement(''div''); + a \ Node_insertBefore_document . createElement(''div''); + b \ Node_insertBefore_document . createElement(''div''); + c \ Node_insertBefore_document . createElement(''div''); assert_throws(NotFoundError, a . insertBefore(b, c)) }) Node_insertBefore_heap" by eval @@ -104,9 +106,9 @@ lemma "test (do { text \"Inserting a node before itself should not move the node"\ lemma "test (do { - a \ document . createElement(''div''); - b \ document . createElement(''div''); - c \ document . createElement(''div''); + a \ Node_insertBefore_document . createElement(''div''); + b \ Node_insertBefore_document . createElement(''div''); + c \ Node_insertBefore_document . createElement(''div''); a . appendChild(b); a . appendChild(c); tmp0 \ a . childNodes; diff --git a/Core_DOM/tests/Node_removeChild.thy b/Core_DOM/common/tests/Node_removeChild.thy similarity index 86% rename from Core_DOM/tests/Node_removeChild.thy rename to Core_DOM/common/tests/Node_removeChild.thy index 74dfa2c..497db8e 100644 --- a/Core_DOM/tests/Node_removeChild.thy +++ b/Core_DOM/common/tests/Node_removeChild.thy @@ -1,5 +1,5 @@ (*********************************************************************************** - * Copyright (c) 2016-2018 The University of Sheffield, UK + * Copyright (c) 2016-2019 The University of Sheffield, UK * * All rights reserved. * @@ -27,15 +27,17 @@ * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) -section\Testing removeChild\ -text\This theory contains the test cases for removeChild.\ +(* This file is automatically generated, please do not modify! *) + +section\Testing Node\_removeChild\ +text\This theory contains the test cases for Node\_removeChild.\ theory Node_removeChild imports "Core_DOM_BaseTest" begin -definition Node_removeChild_heap :: "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" where +definition Node_removeChild_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where "Node_removeChild_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])), (cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 7)] fmempty None)), (cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6)] fmempty None)), @@ -50,17 +52,17 @@ definition Node_removeChild_heap :: "(unit, unit, unit, unit, unit, unit, unit, (cast (element_ptr.Ref 10), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 2)] fmempty None)), (cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]" -definition document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "document = Some (cast (document_ptr.Ref 1))" +definition Node_removeChild_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Node_removeChild_document = Some (cast (document_ptr.Ref 1))" text \"Passing a detached Element to removeChild should not affect it."\ lemma "test (do { - doc \ return document; + doc \ return Node_removeChild_document; s \ doc . createElement(''div''); tmp0 \ s . ownerDocument; assert_equals(tmp0, doc); - tmp1 \ document . body; + tmp1 \ Node_removeChild_document . body; assert_throws(NotFoundError, tmp1 . removeChild(s)); tmp2 \ s . ownerDocument; assert_equals(tmp2, doc) @@ -71,13 +73,13 @@ lemma "test (do { text \"Passing a non-detached Element to removeChild should not affect it."\ lemma "test (do { - doc \ return document; + doc \ return Node_removeChild_document; s \ doc . createElement(''div''); tmp0 \ doc . documentElement; tmp0 . appendChild(s); tmp1 \ s . ownerDocument; assert_equals(tmp1, doc); - tmp2 \ document . body; + tmp2 \ Node_removeChild_document . body; assert_throws(NotFoundError, tmp2 . removeChild(s)); tmp3 \ s . ownerDocument; assert_equals(tmp3, doc) @@ -88,7 +90,7 @@ lemma "test (do { text \"Calling removeChild on an Element with no children should throw NOT\_FOUND\_ERR."\ lemma "test (do { - doc \ return document; + doc \ return Node_removeChild_document; s \ doc . createElement(''div''); tmp0 \ doc . body; tmp0 . appendChild(s); @@ -106,7 +108,7 @@ lemma "test (do { s \ doc . createElement(''div''); tmp0 \ s . ownerDocument; assert_equals(tmp0, doc); - tmp1 \ document . body; + tmp1 \ Node_removeChild_document . body; assert_throws(NotFoundError, tmp1 . removeChild(s)); tmp2 \ s . ownerDocument; assert_equals(tmp2, doc) @@ -123,7 +125,7 @@ lemma "test (do { tmp0 . appendChild(s); tmp1 \ s . ownerDocument; assert_equals(tmp1, doc); - tmp2 \ document . body; + tmp2 \ Node_removeChild_document . body; assert_throws(NotFoundError, tmp2 . removeChild(s)); tmp3 \ s . ownerDocument; assert_equals(tmp3, doc) @@ -148,7 +150,7 @@ lemma "test (do { text \"Passing a value that is not a Node reference to removeChild should throw TypeError."\ lemma "test (do { - tmp0 \ document . body; + tmp0 \ Node_removeChild_document . body; assert_throws(TypeError, tmp0 . removeChild(None)) }) Node_removeChild_heap" by eval diff --git a/Core_DOM/preliminaries/Testing_Utils.thy b/Core_DOM/preliminaries/Testing_Utils.thy deleted file mode 100644 index e8280ba..0000000 --- a/Core_DOM/preliminaries/Testing_Utils.thy +++ /dev/null @@ -1,39 +0,0 @@ -(*********************************************************************************** - * Copyright (c) 2016-2018 The University of Sheffield, UK - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, this - * list of conditions and the following disclaimer. - * - * * Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, - * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * - * SPDX-License-Identifier: BSD-2-Clause - ***********************************************************************************) - -theory Testing_Utils - imports Main -begin -ML \ -val _ = Theory.setup - (Method.setup @{binding timed_code_simp} - (Scan.succeed (SIMPLE_METHOD' o (CHANGED_PROP oo (fn a => fn b => Timeout.apply (seconds 3600.0) (Code_Simp.dynamic_tac a b))))) - "simplification with code equations, aborts after 1 hour"); -\ -end diff --git a/Core_DOM/Core_DOM_Heap_WF.thy b/Core_DOM/standard/Core_DOM_Heap_WF.thy similarity index 73% rename from Core_DOM/Core_DOM_Heap_WF.thy rename to Core_DOM/standard/Core_DOM_Heap_WF.thy index 6937ad9..55e2271 100644 --- a/Core_DOM/Core_DOM_Heap_WF.thy +++ b/Core_DOM/standard/Core_DOM_Heap_WF.thy @@ -47,30 +47,75 @@ locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^su begin definition a_owner_document_valid :: "(_) heap \ bool" where - "a_owner_document_valid h = (\node_ptr. node_ptr |\| node_ptr_kinds h \ + "a_owner_document_valid h \ (\node_ptr \ fset (node_ptr_kinds h). ((\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r) \ (\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)))" +lemma a_owner_document_valid_code [code]: "a_owner_document_valid h \ node_ptr_kinds h |\| + fset_of_list (concat (map (\parent. |h \ get_child_nodes parent|\<^sub>r) (sorted_list_of_fset (object_ptr_kinds h)) @ map (\parent. |h \ get_disconnected_nodes parent|\<^sub>r) (sorted_list_of_fset (document_ptr_kinds h)))) +" + apply(auto simp add: a_owner_document_valid_def l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_owner_document_valid_def)[1] +proof - + fix x + assume 1: " \node_ptr\fset (node_ptr_kinds h). + (\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r) \ + (\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" + assume 2: "x |\| node_ptr_kinds h" + assume 3: "x |\| fset_of_list (concat (map (\parent. |h \ get_disconnected_nodes parent|\<^sub>r) (sorted_list_of_fset (document_ptr_kinds h))))" + have "\(\document_ptr. document_ptr |\| document_ptr_kinds h \ x \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" + using 1 2 3 + by (smt UN_I fset_of_list_elem image_eqI notin_fset set_concat set_map sorted_list_of_fset_simps(1)) + then + have "(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ x \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" + using 1 2 + by auto + then obtain parent_ptr where parent_ptr: "parent_ptr |\| object_ptr_kinds h \ x \ set |h \ get_child_nodes parent_ptr|\<^sub>r" + by auto + moreover have "parent_ptr \ set (sorted_list_of_fset (object_ptr_kinds h))" + using parent_ptr by auto + moreover have "|h \ get_child_nodes parent_ptr|\<^sub>r \ set (map (\parent. |h \ get_child_nodes parent|\<^sub>r) (sorted_list_of_fset (object_ptr_kinds h)))" + using calculation(2) by auto + ultimately + show "x |\| fset_of_list (concat (map (\parent. |h \ get_child_nodes parent|\<^sub>r) (sorted_list_of_fset (object_ptr_kinds h))))" + using fset_of_list_elem by fastforce +next + fix node_ptr + assume 1: "node_ptr_kinds h |\| fset_of_list (concat (map (\parent. |h \ get_child_nodes parent|\<^sub>r) (sorted_list_of_fset (object_ptr_kinds h)))) |\| fset_of_list (concat (map (\parent. |h \ get_disconnected_nodes parent|\<^sub>r) (sorted_list_of_fset (document_ptr_kinds h))))" + assume 2: "node_ptr |\| node_ptr_kinds h" + assume 3: "\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r" + have "node_ptr \ set (concat (map (\parent. |h \ get_child_nodes parent|\<^sub>r) (sorted_list_of_fset (object_ptr_kinds h)))) \ node_ptr \ set (concat (map (\parent. |h \ get_disconnected_nodes parent|\<^sub>r) (sorted_list_of_fset (document_ptr_kinds h))))" + using 1 2 + by (meson fin_mono fset_of_list_elem funion_iff) + then + show "\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" + using 3 + by auto +qed definition a_parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" where "a_parent_child_rel h = {(parent, child). parent |\| object_ptr_kinds h \ child \ cast ` set |h \ get_child_nodes parent|\<^sub>r}" +lemma a_parent_child_rel_code [code]: "a_parent_child_rel h = set (concat (map + (\parent. map + (\child. (parent, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child)) + |h \ get_child_nodes parent|\<^sub>r) + (sorted_list_of_fset (object_ptr_kinds h))) +)" + by(auto simp add: a_parent_child_rel_def) + definition a_acyclic_heap :: "(_) heap \ bool" where "a_acyclic_heap h = acyclic (a_parent_child_rel h)" - definition a_all_ptrs_in_heap :: "(_) heap \ bool" where - "a_all_ptrs_in_heap h = ((\ptr children. (h \ get_child_nodes ptr \\<^sub>r children) - \ fset_of_list children |\| node_ptr_kinds h) - \ (\document_ptr disc_node_ptrs. (h \ get_disconnected_nodes document_ptr \\<^sub>r disc_node_ptrs) - \ fset_of_list disc_node_ptrs |\| node_ptr_kinds h))" - + "a_all_ptrs_in_heap h \ + (\ptr \ fset (object_ptr_kinds h). set |h \ get_child_nodes ptr|\<^sub>r \ fset (node_ptr_kinds h)) \ + (\document_ptr \ fset (document_ptr_kinds h). set |h \ get_disconnected_nodes document_ptr|\<^sub>r \ fset (node_ptr_kinds h))" definition a_distinct_lists :: "(_) heap \ bool" where @@ -94,6 +139,10 @@ global_interpretation l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes get_disconnected_nodes" and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes" + and acyclic_heap = a_acyclic_heap + and all_ptrs_in_heap = a_all_ptrs_in_heap + and distinct_lists = a_distinct_lists + and owner_document_valid = a_owner_document_valid . locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = @@ -218,7 +267,7 @@ lemma heap_is_wellformed_children_in_heap: shows "child |\| node_ptr_kinds h" using assms apply(auto simp add: heap_is_wellformed_def a_all_ptrs_in_heap_def)[1] - by (meson fset_of_list_elem fset_rev_mp) + by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.get_child_nodes_ptr_in_heap select_result_I2 subsetD) lemma heap_is_wellformed_one_parent: assumes "heap_is_wellformed h" @@ -267,12 +316,12 @@ lemma parent_child_rel_child_in_heap: \ (parent, child_ptr) \ parent_child_rel h \ child_ptr |\| object_ptr_kinds h" apply(auto simp add: heap_is_wellformed_def parent_child_rel_def a_all_ptrs_in_heap_def)[1] using get_child_nodes_ok - by (meson fin_mono fset_of_list_elem returns_result_select_result) + by (meson finite_set_in subsetD) lemma heap_is_wellformed_disc_nodes_in_heap: "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ node \ set disc_nodes \ node |\| node_ptr_kinds h" - by (meson fset_mp fset_of_list_elem local.a_all_ptrs_in_heap_def local.heap_is_wellformed_def) + by (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.a_all_ptrs_in_heap_def local.get_disconnected_nodes_ptr_in_heap local.heap_is_wellformed_def select_result_I2 subsetD) lemma heap_is_wellformed_one_disc_parent: "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes @@ -517,8 +566,8 @@ proof - proof (induct rule: wf_induct_rule) case (less parent) then show ?case - using assms child_parent_dual parent_child_rel_parent - by (meson converse_iff parent_child_rel_child) + using assms parent_child_rel_child + by (meson converse_iff) qed qed @@ -667,8 +716,7 @@ proof - moreover have "a_all_ptrs_in_heap h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) then have "a_all_ptrs_in_heap h'" - by(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_def node_ptr_kinds_eq2 - object_ptr_kinds_eq3 children_eq disconnected_nodes_eq) + by (simp add: children_eq2 disconnected_nodes_eq2 document_ptr_kinds_eq3 l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_all_ptrs_in_heap_def node_ptr_kinds_eq3 object_ptr_kinds_eq3) moreover have h0: "a_distinct_lists h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) @@ -1764,9 +1812,6 @@ locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l assumes get_root_node_same_no_parent: "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_root_node ptr \\<^sub>r cast child \ h \ get_parent child \\<^sub>r None" - assumes get_root_node_not_node_same: - "ptr |\| object_ptr_kinds h \ \is_node_ptr_kind ptr - \ h \ get_root_node ptr \\<^sub>r ptr" assumes get_root_node_parent_same: "h \ get_parent child \\<^sub>r Some ptr \ h \ get_root_node (cast child) \\<^sub>r root \ h \ get_root_node ptr \\<^sub>r root" @@ -1805,17 +1850,11 @@ lemma get_root_node_wf_is_l_get_root_node_wf [instances]: 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 subsection \to\_tree\_order\ -(* lemma to_tree_order_reads: - assumes "a_heap_is_wellformed h" - shows "reads (all_ptrs (getter_preserved_set_ext \ {get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_preserved document_element} - \ {get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_preserved Element.child_nodes})) (to_tree_order ptr) h h'" - oops *) locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + @@ -2374,13 +2413,8 @@ lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: subsubsection \get\_root\_node\ locale l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_get_ancestors - + l_get_ancestors_wf - + l_get_root_node - + l_get_root_node_wf + l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_to_tree_order_wf - + l_get_parent - + l_get_parent_wf begin lemma to_tree_order_get_root_node: assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" @@ -2467,9 +2501,7 @@ qed end interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - get_ancestors get_ancestors_locs heap_is_wellformed parent_child_rel known_ptr - known_ptrs type_wf get_child_nodes get_child_nodes_locs get_parent get_parent_locs - get_root_node get_root_node_locs to_tree_order + known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order using instances by(simp add: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) @@ -2501,11 +2533,12 @@ subsection \get\_owner\_document\ locale l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_known_ptrs + l_heap_is_wellformed - + l_get_root_node + + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_ancestors + l_get_ancestors_wf + l_get_parent + l_get_parent_wf + + l_get_root_node_wf + l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin @@ -2629,8 +2662,7 @@ proof - by (metis (no_types, hide_lams)) moreover have "node_ptr |\| node_ptr_kinds h" using assms(2) get_parent_ptr_in_heap by blast - thm heap_is_wellformed_children_disc_nodes_different - ultimately + ultimately have 0: "\document_ptr\set |h \ document_ptr_kinds_M|\<^sub>r. node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" by (metis DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) finite_set_in heap_is_wellformed_children_disc_nodes) then obtain document_ptr where @@ -2643,6 +2675,286 @@ proof - returns_result_select_result select_result_I2 by (metis (no_types, hide_lams) ) 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 \\<^sub>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)[1] + apply(split invoke_split_asm)+ +proof - + assume "h \ invoke [] ptr () \\<^sub>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) + (\_. (local.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \ the \ cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ()) + \\<^sub>r owner_document" + then show "owner_document |\| document_ptr_kinds h" + by(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: if_splits) +next + assume 0: "heap_is_wellformed h" + and 1: "type_wf h" + and 2: "known_ptrs h" + and 3: "\ is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" + and 4: "is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" + and 5: "h \ Heap_Error_Monad.bind (check_in_heap ptr) (\_. (local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \ the \ cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ()) \\<^sub>r owner_document" + then obtain root where + root: "h \ get_root_node ptr \\<^sub>r root" + by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits) + + then show ?thesis + proof (cases "is_document_ptr root") + case True + then show ?thesis + using 4 5 root + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: filter_M_pure_I bind_pure_I split: option.splits)[1] + apply(drule(1) returns_result_eq) apply(auto)[1] + using "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast + next + case False + have "known_ptr root" + using "0" "1" "2" local.get_root_node_root_in_heap local.known_ptrs_known_ptr root by blast + have "root |\| object_ptr_kinds h" + using root + using "0" "1" "2" local.get_root_node_root_in_heap + by blast + then have "is_node_ptr_kind root" + using False \known_ptr root\ + apply(simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs) + using is_node_ptr_kind_none by force + then + have "(\document_ptr \ fset (document_ptr_kinds h). root \ cast ` set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" + by (metis (no_types, lifting) "0" "1" "2" \root |\| object_ptr_kinds h\ local.child_parent_dual local.get_child_nodes_ok local.get_root_node_same_no_parent local.heap_is_wellformed_children_disc_nodes local.known_ptrs_known_ptr node_ptr_casts_commute3 node_ptr_inclusion node_ptr_kinds_commutes notin_fset option.distinct(1) returns_result_eq returns_result_select_result root) + then obtain some_owner_document where + "some_owner_document |\| document_ptr_kinds h" and + "root \ cast ` set |h \ get_disconnected_nodes some_owner_document|\<^sub>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 \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ` set disconnected_nodes))) + (sorted_list_of_set (fset (document_ptr_kinds h))) + \\<^sub>r candidates" + by (metis (no_types, lifting) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset return_ok return_pure sorted_list_of_set(1)) + then have "some_owner_document \ 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|\<^sub>r\ + apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1] + apply (simp add: \some_owner_document |\| document_ptr_kinds h\) + using "1" \root \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ` set |h \ get_disconnected_nodes some_owner_document|\<^sub>r\ \some_owner_document |\| document_ptr_kinds h\ + local.get_disconnected_nodes_ok by auto + then have "candidates \ []" + by auto + then have "owner_document \ set candidates" + using 5 root 4 + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: filter_M_pure_I bind_pure_I split: option.splits)[1] + apply (metis candidates list.set_sel(1) returns_result_eq) + by (metis \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 +next + assume 0: "heap_is_wellformed h" + and 1: "type_wf h" + and 2: "known_ptrs h" + and 3: "is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" + and 4: "h \ Heap_Error_Monad.bind (check_in_heap ptr) (\_. (local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \ the \ cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ()) \\<^sub>r owner_document" + then obtain root where + root: "h \ get_root_node ptr \\<^sub>r root" + by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits) + + then show ?thesis + proof (cases "is_document_ptr root") + case True + then show ?thesis + using 3 4 root + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: filter_M_pure_I bind_pure_I split: option.splits)[1] + apply(drule(1) returns_result_eq) apply(auto)[1] + using "0" "1" "2" document_ptr_kinds_commutes local.get_root_node_root_in_heap by blast + next + case False + have "known_ptr root" + using "0" "1" "2" local.get_root_node_root_in_heap local.known_ptrs_known_ptr root by blast + have "root |\| object_ptr_kinds h" + using root + using "0" "1" "2" local.get_root_node_root_in_heap + by blast + then have "is_node_ptr_kind root" + using False \known_ptr root\ + apply(simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs) + using is_node_ptr_kind_none by force + then + have "(\document_ptr \ fset (document_ptr_kinds h). root \ cast ` set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" + by (metis (no_types, lifting) "0" "1" "2" \root |\| object_ptr_kinds h\ local.child_parent_dual local.get_child_nodes_ok local.get_root_node_same_no_parent local.heap_is_wellformed_children_disc_nodes local.known_ptrs_known_ptr node_ptr_casts_commute3 node_ptr_inclusion node_ptr_kinds_commutes notin_fset option.distinct(1) returns_result_eq returns_result_select_result root) + then obtain some_owner_document where + "some_owner_document |\| document_ptr_kinds h" and + "root \ cast ` set |h \ get_disconnected_nodes some_owner_document|\<^sub>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 \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ` set disconnected_nodes))) + (sorted_list_of_set (fset (document_ptr_kinds h))) + \\<^sub>r candidates" + by (metis (no_types, lifting) "1" bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure notin_fset return_ok return_pure sorted_list_of_set(1)) + then have "some_owner_document \ 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|\<^sub>r\ + apply(auto intro!: bind_pure_I bind_pure_returns_result_I) + by (simp add: "1" local.get_disconnected_nodes_ok) + + then have "candidates \ []" + by auto + then have "owner_document \ set candidates" + using 4 root 3 + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: filter_M_pure_I bind_pure_I split: option.splits)[1] + apply (metis candidates list.set_sel(1) returns_result_eq) + by (metis \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_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(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] + apply(split invoke_splits, (rule conjI | rule impI)+)+ + apply(auto simp add: known_ptr_impl)[1] + using NodeClass.a_known_ptr_def known_ptr_not_character_data_ptr known_ptr_not_document_ptr known_ptr_not_element_ptr + apply blast + using assms(4) + apply(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_is_OK_pure_I)[1] + apply (metis (no_types, lifting) document_ptr_casts_commute3 document_ptr_kinds_commutes is_document_ptr_kind_none option.case_eq_if) + using assms(4) + apply(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_is_OK_pure_I)[1] + apply (metis (no_types, lifting) assms(1) assms(2) assms(3) is_node_ptr_kind_none local.get_root_node_ok node_ptr_casts_commute3 option.case_eq_if) + using assms(4) + apply(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_is_OK_pure_I)[1] + apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1] + using assms(3) local.get_disconnected_nodes_ok + apply blast + apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok) + using assms(4) + apply(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_is_OK_pure_I)[1] + apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1] + apply (simp add: assms(1) assms(2) assms(3) local.get_root_node_ok)[1] + apply(auto split: option.splits intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I)[1] + using assms(3) local.get_disconnected_nodes_ok by blast +qed + +lemma get_owner_document_child_same: + assumes "heap_is_wellformed h" "known_ptrs h" "type_wf h" + assumes "h \ get_child_nodes ptr \\<^sub>r children" + assumes "child \ set children" + shows "h \ get_owner_document ptr \\<^sub>r owner_document \ h \ get_owner_document (cast child) \\<^sub>r owner_document" +proof - + have "ptr |\| object_ptr_kinds h" + by (meson assms(4) is_OK_returns_result_I local.get_child_nodes_ptr_in_heap) + then have "known_ptr ptr" + using assms(2) local.known_ptrs_known_ptr by blast + + have "cast child |\| object_ptr_kinds h" + using assms(1) assms(4) assms(5) local.heap_is_wellformed_children_in_heap node_ptr_kinds_commutes by blast + then + have "known_ptr (cast child)" + using assms(2) local.known_ptrs_known_ptr by blast + + obtain root where root: "h \ get_root_node ptr \\<^sub>r root" + by (meson \ptr |\| object_ptr_kinds h\ assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_root_node_ok) + then have "h \ get_root_node (cast child) \\<^sub>r root" + using assms(1) assms(2) assms(3) assms(4) assms(5) local.child_parent_dual local.get_root_node_parent_same by blast + + have "h \ get_owner_document ptr \\<^sub>r owner_document \ h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \\<^sub>r owner_document" + proof (cases "is_document_ptr ptr") + case True + then obtain document_ptr where document_ptr: "cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr = ptr" + using case_optionE document_ptr_casts_commute by blast + then have "root = cast document_ptr" + using root + by(auto simp add: get_root_node_def get_ancestors_def elim!: bind_returns_result_E2 split: option.splits) + + then have "h \ a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr () \\<^sub>r owner_document \ h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \\<^sub>r owner_document" + using document_ptr \h \ get_root_node (cast child) \\<^sub>r root\[simplified \root = cast document_ptr\ document_ptr] + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 dest!: bind_returns_result_E3[rotated, OF \h \ get_root_node (cast child) \\<^sub>r root\[simplified \root = cast document_ptr\ document_ptr], rotated] intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: if_splits option.splits)[1] + using \ptr |\| object_ptr_kinds h\ document_ptr_kinds_commutes by blast + then show ?thesis + using \known_ptr ptr\ + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_impl)[1] + apply(split invoke_splits, ((rule conjI | rule impI)+)?)+ + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_element_ptr) + apply(simp add: NodeClass.known_ptr_defs) + using \ptr |\| object_ptr_kinds h\ True + by(auto simp add: document_ptr[symmetric] intro!: bind_pure_returns_result_I split: option.splits) + next + case False + then obtain node_ptr where node_ptr: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr = ptr" + using \known_ptr ptr\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then have "h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r owner_document \ h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child () \\<^sub>r owner_document" + using root \h \ get_root_node (cast child) \\<^sub>r root\ + unfolding a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def + by (meson bind_pure_returns_result_I bind_returns_result_E3 local.get_root_node_pure) + then show ?thesis + using \known_ptr ptr\ + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_impl) + apply(split invoke_splits, ((rule conjI | rule impI)+)?)+ + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_element_ptr) + apply(simp add: NodeClass.known_ptr_defs) + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ False + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ False + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ False + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ False + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + apply(split invoke_splits, ((rule conjI | rule impI)+)?)+ + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + apply (meson invoke_empty is_OK_returns_result_I) + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + apply(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + by(auto simp add: node_ptr[symmetric] intro!: bind_pure_returns_result_I split: )[1] + qed + then show ?thesis + using \known_ptr (cast child)\ + apply(auto simp add: get_owner_document_def[of "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child"] a_get_owner_document_tups_def known_ptr_impl)[1] + apply(split invoke_splits, ((rule conjI | rule impI)+)?)+ + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_element_ptr) + apply(simp add: NodeClass.known_ptr_defs) + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ + apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ + apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ + apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] + using \cast child |\| object_ptr_kinds h\ \ptr |\| object_ptr_kinds h\ + apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] + by (smt \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child |\| object_ptr_kinds h\ cast_document_ptr_not_node_ptr(1) comp_apply invoke_empty invoke_not invoke_returns_result is_OK_returns_result_I node_ptr_casts_commute2 option.sel) +qed + end locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs @@ -2663,37 +2975,224 @@ locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known known_ptrs h \ type_wf h\ node_ptr \ set disc_nodes" + assumes get_owner_document_owner_document_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_owner_document ptr \\<^sub>r owner_document \ owner_document |\| document_ptr_kinds h" + assumes get_owner_document_ok: + "heap_is_wellformed h \ known_ptrs h \ type_wf h \ ptr |\| object_ptr_kinds h + \ h \ ok (get_owner_document ptr)" -interpretation i_get_owner_document_wf?: - l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf heap_is_wellformed parent_child_rel - get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs - get_root_node get_root_node_locs get_parent get_parent_locs get_ancestors get_ancestors_locs - get_owner_document - using known_ptrs_is_l_known_ptrs - using heap_is_wellformed_is_l_heap_is_wellformed - using get_root_node_is_l_get_root_node - using get_ancestors_is_l_get_ancestors - using get_ancestors_wf_is_l_get_ancestors_wf - using get_parent_is_l_get_parent - using get_ancestors_wf_is_l_get_ancestors_wf - using get_parent_wf_is_l_get_parent_wf - using l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms - by(simp add: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) - - +interpretation i_get_owner_document_wf?: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + known_ptr known_ptrs type_wf heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs get_owner_document + by(auto simp add: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) +declare l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] lemma get_owner_document_wf_is_l_get_owner_document_wf [instances]: "l_get_owner_document_wf heap_is_wellformed type_wf known_ptr known_ptrs get_disconnected_nodes get_owner_document get_parent" using known_ptrs_is_l_known_ptrs - apply(simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def) - using get_owner_document_disconnected_nodes in_disconnected_nodes_no_parent - by fast + apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def)[1] + using get_owner_document_disconnected_nodes apply fast + using in_disconnected_nodes_no_parent apply fast + using get_owner_document_owner_document_in_heap apply fast + using get_owner_document_ok apply fast + done + + +subsubsection \get\_root\_node\ + +locale l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_get_root_node_wf + + l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_get_owner_document_wf +begin + +lemma get_root_node_document: + assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" + assumes "h \ get_root_node ptr \\<^sub>r root" + assumes "is_document_ptr_kind root" + shows "h \ get_owner_document ptr \\<^sub>r the (cast root)" +proof - + have "ptr |\| object_ptr_kinds h" + using assms(4) + by (meson is_OK_returns_result_I local.get_root_node_ptr_in_heap) + then have "known_ptr ptr" + using assms(3) local.known_ptrs_known_ptr by blast + { + assume "is_document_ptr_kind ptr" + then have "ptr = root" + using assms(4) + by(auto simp add: get_root_node_def get_ancestors_def elim!: bind_returns_result_E2 split: option.splits) + then have ?thesis + using \is_document_ptr_kind ptr\ \known_ptr ptr\ \ptr |\| object_ptr_kinds h\ + apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def)[1] + apply(split invoke_splits, (rule conjI | rule impI)+)+ + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_element_ptr) + apply(simp add: NodeClass.known_ptr_defs) + by(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_pure_returns_result_I split: option.splits) + } + moreover + { + assume "is_node_ptr_kind ptr" + then have ?thesis + using \known_ptr ptr\ \ptr |\| object_ptr_kinds h\ + apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits, (rule conjI | rule impI)+)+ + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_element_ptr) + apply(simp add: NodeClass.known_ptr_defs) + apply(auto split: option.splits)[1] + using \h \ get_root_node ptr \\<^sub>r root\ assms(5) + by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def is_document_ptr_kind_def intro!: bind_pure_returns_result_I split: option.splits)[2] + } + ultimately + show ?thesis + using \known_ptr ptr\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) +qed + +lemma get_root_node_same_owner_document: + assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" + assumes "h \ get_root_node ptr \\<^sub>r root" + shows "h \ get_owner_document ptr \\<^sub>r owner_document \ h \ get_owner_document root \\<^sub>r owner_document" +proof - + have "ptr |\| object_ptr_kinds h" + by (meson assms(4) is_OK_returns_result_I local.get_root_node_ptr_in_heap) + have "root |\| object_ptr_kinds h" + using assms(1) assms(2) assms(3) assms(4) local.get_root_node_root_in_heap by blast + have "known_ptr ptr" + using \ptr |\| object_ptr_kinds h\ assms(3) local.known_ptrs_known_ptr by blast + have "known_ptr root" + using \root |\| object_ptr_kinds h\ assms(3) local.known_ptrs_known_ptr by blast + show ?thesis + proof (cases "is_document_ptr_kind ptr") + case True + then + have "ptr = root" + using assms(4) + apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2)[1] + by (metis document_ptr_casts_commute3 last_ConsL local.get_ancestors_not_node node_ptr_no_document_ptr_cast) + then show ?thesis + by auto + next + case False + then have "is_node_ptr_kind ptr" + using \known_ptr ptr\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then obtain node_ptr where node_ptr: "ptr = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr" + by (metis node_ptr_casts_commute3) + show ?thesis + proof + assume "h \ get_owner_document ptr \\<^sub>r owner_document" + then have "h \ local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r owner_document" + using node_ptr + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] + apply(split invoke_splits)+ + apply (meson invoke_empty is_OK_returns_result_I) + by(auto elim!: bind_returns_result_E2 split: option.splits) + + show "h \ get_owner_document root \\<^sub>r owner_document" + proof (cases "is_document_ptr_kind root") + case True + have "is_document_ptr root" + using True \known_ptr root\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + have "root = cast owner_document" + using True + by (smt \h \ get_owner_document ptr \\<^sub>r owner_document\ assms(1) assms(2) assms(3) assms(4) document_ptr_casts_commute3 get_root_node_document returns_result_eq) + then show ?thesis + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits, (rule conjI | rule impI)+)+ + using \is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root\ apply blast + using \root |\| object_ptr_kinds h\ + by(auto simp add: a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def is_node_ptr_kind_none) + + next + case False + then have "is_node_ptr_kind root" + using \known_ptr root\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then obtain root_node_ptr where root_node_ptr: "root = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr" + by (metis node_ptr_casts_commute3) + then have "h \ local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr () \\<^sub>r owner_document" + using \h \ local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r owner_document\ assms(4) + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits) + apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq) + using \is_node_ptr_kind root\ node_ptr returns_result_eq by fastforce + then show ?thesis + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits, (rule conjI | rule impI)+)+ + using \is_node_ptr_kind root\ \known_ptr root\ + apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)[2] + using \root |\| object_ptr_kinds h\ + by(auto simp add: root_node_ptr) + qed + next + assume "h \ get_owner_document root \\<^sub>r owner_document" + show "h \ get_owner_document ptr \\<^sub>r owner_document" + proof (cases "is_document_ptr_kind root") + case True + have "root = cast owner_document" + using \h \ get_owner_document root \\<^sub>r owner_document\ + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits)+ + apply (meson invoke_empty is_OK_returns_result_I) + apply(auto simp add: True a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: if_splits) + apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3 is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + then show ?thesis + using assms(1) assms(2) assms(3) assms(4) get_root_node_document + by fastforce + next + case False + then have "is_node_ptr_kind root" + using \known_ptr root\ + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then obtain root_node_ptr where root_node_ptr: "root = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr" + by (metis node_ptr_casts_commute3) + then have "h \ local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r root_node_ptr () \\<^sub>r owner_document" + using \h \ get_owner_document root \\<^sub>r owner_document\ + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits)+ + apply (meson invoke_empty is_OK_returns_result_I) + by(auto simp add: is_document_ptr_kind_none elim!: bind_returns_result_E2) + then have "h \ local.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r owner_document" + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits) + using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr + by fastforce+ + then show ?thesis + apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def) + apply(split invoke_splits, (rule conjI | rule impI)+)+ + using node_ptr \known_ptr ptr\ \ptr |\| object_ptr_kinds h\ + + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs intro!: bind_pure_returns_result_I split: option.splits) + qed + qed + qed +qed +end + +interpretation get_owner_document_wf_get_root_node_wf?: l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs heap_is_wellformed parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs get_owner_document + by(auto simp add: l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) +declare l_get_owner_document_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] + +locale l_get_owner_document_wf_get_root_node_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + l_get_root_node_defs + l_get_owner_document_defs + + assumes get_root_node_document: "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_root_node ptr \\<^sub>r root \ is_document_ptr_kind root \ h \ get_owner_document ptr \\<^sub>r the (cast root)" + assumes get_root_node_same_owner_document: "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_root_node ptr \\<^sub>r root \ h \ get_owner_document ptr \\<^sub>r owner_document \ h \ get_owner_document root \\<^sub>r owner_document" + +lemma get_owner_document_wf_get_root_node_wf_is_l_get_owner_document_wf_get_root_node_wf [instances]: + "l_get_owner_document_wf_get_root_node_wf heap_is_wellformed type_wf known_ptr known_ptrs get_root_node get_owner_document" + apply(auto simp add: l_get_owner_document_wf_get_root_node_wf_def l_get_owner_document_wf_get_root_node_wf_axioms_def instances) + using get_root_node_document apply blast + using get_root_node_same_owner_document apply (blast, blast) + done subsection \Preserving heap-wellformedness\ - subsection \set\_attribute\ locale l_set_attribute_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = @@ -3095,20 +3594,9 @@ have "type_wf h2" using assms(1) by (simp add: heap_is_wellformed_def) then have "a_all_ptrs_in_heap h'" apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3 disconnected_nodes_eq)[1] - apply (metis (no_types, lifting) type_wf assms(3) children_eq2 children_h children_h' - fset_of_list_subset fsubsetD get_child_nodes_ok get_child_nodes_ptr_in_heap - is_OK_returns_result_E is_OK_returns_result_I local.known_ptrs_known_ptr - object_ptr_kinds_eq3 select_result_I2 set_remove1_subset) - by (metis (no_types, lifting) - \\thesis. (\owner_document children_h h2 disconnected_nodes_h. - \h \ get_owner_document (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r owner_document; - h \ get_child_nodes ptr \\<^sub>r children_h; child \ set children_h; - h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h; - h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2; - h2 \ set_child_nodes ptr (remove1 child children_h) \\<^sub>h h'\ \ thesis) \ thesis\ - disconnected_nodes_h disconnected_nodes_eq disconnected_nodes_h' fset_mp fset_of_list_elem - returns_result_eq set_ConsD) - + apply (metis (no_types, lifting) \type_wf h'\ assms(2) assms(3) local.get_child_nodes_ok local.known_ptrs_known_ptr local.remove_child_children_subset notin_fset object_ptr_kinds_eq3 returns_result_select_result subset_code(1) type_wf) + apply (metis (no_types, lifting) assms(2) disconnected_nodes_eq2 disconnected_nodes_h disconnected_nodes_h' document_ptr_kinds_eq3 finite_set_in local.remove_child_child_in_heap node_ptr_kinds_eq3 select_result_I2 set_ConsD subset_code(1)) + done moreover have "a_owner_document_valid h" using assms(1) by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" @@ -3116,14 +3604,9 @@ have "type_wf h2" node_ptr_kinds_eq3)[1] proof - fix node_ptr - assume 0: "\node_ptr. node_ptr |\| node_ptr_kinds h' - \ (\document_ptr. document_ptr |\| document_ptr_kinds h' - \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r) - \ (\parent_ptr. parent_ptr |\| object_ptr_kinds h' - \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>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|\<^sub>r" +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|\<^sub>r) \ (\parent_ptr. parent_ptr |\| object_ptr_kinds h' \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>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|\<^sub>r" then show "\document_ptr. document_ptr |\| document_ptr_kinds h' \ node_ptr \ set |h' \ get_disconnected_nodes document_ptr|\<^sub>r" proof (cases "node_ptr = child") @@ -3139,7 +3622,7 @@ have "type_wf h2" using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h disconnected_nodes_h' apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1] - by (metis children_eq2 disconnected_nodes_eq2 in_set_remove1 list.set_intros(2)) + by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2)) qed qed @@ -3437,6 +3920,15 @@ assume 1: "xa \ fset (object_ptr_kinds h')" using heap_is_wellformed_def by blast qed +lemma remove_heap_is_wellformed_preserved: + assumes "heap_is_wellformed h" + and "h \ remove child \\<^sub>h h'" + and "known_ptrs h" + and type_wf: "type_wf h" + shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'" + using assms + by(auto simp add: remove_def intro: remove_child_heap_is_wellformed_preserved elim!: bind_returns_heap_E2 split: option.splits) + lemma remove_child_removes_child: assumes wellformed: "heap_is_wellformed h" and remove_child: "h \ remove_child ptr' child \\<^sub>h h'" @@ -3469,7 +3961,7 @@ proof - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_child_writes assms(2)] using set_child_nodes_types_preserved set_disconnected_nodes_types_preserved type_wf unfolding remove_child_locs_def - apply(auto simp add: reflp_def transp_def) + apply(auto simp add: reflp_def transp_def)[1] by blast ultimately show ?thesis using remove_child_removes_parent remove_child_heap_is_wellformed_preserved child_parent_dual @@ -3590,6 +4082,15 @@ locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_h assumes remove_child_heap_is_wellformed_preserved: "type_wf h \ known_ptrs h \ heap_is_wellformed h \ h \ remove_child ptr child \\<^sub>h h' \ heap_is_wellformed h'" + assumes remove_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove child \\<^sub>h h' + \ type_wf h'" + assumes remove_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove child \\<^sub>h h' + \ known_ptrs h'" + assumes remove_heap_is_wellformed_preserved: + "type_wf h \ known_ptrs h \ heap_is_wellformed h \ h \ remove child \\<^sub>h h' + \ heap_is_wellformed h'" assumes remove_child_removes_child: "heap_is_wellformed h \ h \ remove_child ptr' child \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children \ known_ptrs h \ type_wf h @@ -3618,6 +4119,7 @@ lemma remove_child_wf2_is_l_remove_child_wf2 [instances]: "l_remove_child_wf2 type_wf known_ptr known_ptrs remove_child heap_is_wellformed get_child_nodes remove" apply(auto simp add: l_remove_child_wf2_def l_remove_child_wf2_axioms_def instances)[1] using remove_child_heap_is_wellformed_preserved apply(fast, fast, fast) + using remove_heap_is_wellformed_preserved apply(fast, fast, fast) using remove_child_removes_child apply fast using remove_child_removes_first_child apply fast using remove_removes_child apply fast @@ -3631,6 +4133,7 @@ subsection \adopt\_node\ locale l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_parent_wf + + l_get_owner_document_wf + l_remove_child_wf2 + l_heap_is_wellformed begin @@ -3665,6 +4168,65 @@ proof - dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes] split: if_splits) qed + + +lemma adopt_node_document_in_heap: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ ok (adopt_node owner_document node)" + shows "owner_document |\| document_ptr_kinds h" +proof - + obtain old_document parent_opt h2 h' where + old_document: "h \ get_owner_document (cast node) \\<^sub>r old_document" and + parent_opt: "h \ get_parent node \\<^sub>r parent_opt" and + h2: "h \ (case parent_opt of Some parent \ do { remove_child parent node } | None \ do { return ()}) \\<^sub>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 old_disc_nodes); + disc_nodes \ get_disconnected_nodes owner_document; + set_disconnected_nodes owner_document (node # disc_nodes) + } else do { return () }) \\<^sub>h h'" + using assms(4) + by(auto simp add: adopt_node_def + elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) + show ?thesis + proof (cases "owner_document = old_document") + case True + then show ?thesis + using old_document get_owner_document_owner_document_in_heap assms(1) assms(2) assms(3) + by auto + next + case False + + then obtain h3 old_disc_nodes disc_nodes where + old_disc_nodes: "h2 \ get_disconnected_nodes old_document \\<^sub>r old_disc_nodes" and + h3: "h2 \ set_disconnected_nodes old_document (remove1 node old_disc_nodes) \\<^sub>h h3" and + old_disc_nodes: "h3 \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" and + h': "h3 \ set_disconnected_nodes owner_document (node # disc_nodes) \\<^sub>h h'" + using h' + by(auto elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + then have "owner_document |\| document_ptr_kinds h3" + by (meson is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) + + moreover have "object_ptr_kinds h = object_ptr_kinds h2" + using h2 apply(simp split: option.splits) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes]) + using remove_child_pointers_preserved + by (auto simp add: reflp_def transp_def) + moreover have "object_ptr_kinds h2 = object_ptr_kinds h3" + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF set_disconnected_nodes_writes h3]) + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + by (auto simp add: reflp_def transp_def) + + ultimately show ?thesis + by(auto simp add: document_ptr_kinds_def) + qed +qed end locale l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = @@ -3724,12 +4286,19 @@ proof - qed qed +lemma adopt_node_removes_child_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ adopt_node owner_document node_ptr \\<^sub>h h'" +shows "\ptr' children'. + h' \ get_child_nodes ptr' \\<^sub>r children' \ node_ptr \ set children'" + using adopt_node_removes_child assms by blast + lemma adopt_node_preserves_wellformedness: assumes "heap_is_wellformed h" and "h \ adopt_node document_ptr child \\<^sub>h h'" and known_ptrs: "known_ptrs h" and type_wf: "type_wf h" - shows "heap_is_wellformed 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) \\<^sub>r old_document" @@ -3768,11 +4337,17 @@ proof - have wellformed_h2: "heap_is_wellformed h2" using h2 remove_child_heap_is_wellformed_preserved known_ptrs type_wf by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) - then show ?thesis + have "type_wf h2" + using h2 remove_child_preserves_type_wf known_ptrs type_wf + by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) + have "known_ptrs h2" + using h2 remove_child_preserves_known_ptrs known_ptrs type_wf + by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) + have "heap_is_wellformed h' \ known_ptrs h' \ type_wf h'" proof(cases "document_ptr = old_document") case True then show ?thesis - using h' wellformed_h2 by auto + using h' wellformed_h2 \type_wf h2\ \known_ptrs h2\ by auto next case False then obtain h3 old_disc_nodes disc_nodes_document_ptr_h3 where @@ -3881,6 +4456,11 @@ proof - using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) + have "known_ptrs h3" + using known_ptrs local.known_ptrs_preserved object_ptr_kinds_h2_eq3 object_ptr_kinds_h_eq3 by blast + then have "known_ptrs h'" + using local.known_ptrs_preserved object_ptr_kinds_h3_eq3 by blast + have disconnected_nodes_eq_h3: "\doc_ptr disc_nodes. document_ptr \ doc_ptr \ h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h' \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" @@ -3964,15 +4544,12 @@ proof - using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_all_ptrs_in_heap h3" apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1] - by (metis (mono_tags, lifting) disc_nodes_old_document_h2 disc_nodes_old_document_h3 - disconnected_nodes_eq_h2 fset_of_list_elem fset_rev_mp returns_result_eq - set_remove1_subset subsetCE) + apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1)) + by (metis (no_types, lifting) \child \ set disc_nodes_old_document_h2\ \type_wf h2\ disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2 in_set_remove1 local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 returns_result_select_result select_result_I2 wellformed_h2) then have "a_all_ptrs_in_heap h'" apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1] - by (metis (no_types) NodeMonad.ptr_kinds_ptr_kinds_M child_in_heap disc_nodes_document_ptr_h' - disc_nodes_document_ptr_h3 disconnected_nodes_eq_h3 fset_mp fset_of_list_elem - node_ptr_kinds_eq_h node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 select_result_I2 - set_ConsD) + apply (simp add: children_eq2_h3 object_ptr_kinds_h3_eq3 subset_code(1)) + by (metis (no_types, 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 finite_set_in local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 select_result_I2 set_ConsD subset_code(1) wellformed_h2) moreover have "a_owner_document_valid h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) @@ -3980,7 +4557,7 @@ proof - apply(simp add: a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3 object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 children_eq2_h2 children_eq2_h3 ) - by (metis (no_types) disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 + by (smt disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_in_heap document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 in_set_remove1 @@ -4244,8 +4821,10 @@ proof - qed qed ultimately show ?thesis - using \type_wf h'\ \a_owner_document_valid h'\ heap_is_wellformed_def by blast + using \type_wf h'\ \known_ptrs h'\ \a_owner_document_valid h'\ heap_is_wellformed_def by blast qed + then show "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'" + by auto qed lemma adopt_node_node_in_disconnected_nodes: @@ -4343,6 +4922,16 @@ locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_ado \ h \ adopt_node owner_document node \\<^sub>h h' \ h \ get_child_nodes ptr' \\<^sub>r node # children \ h' \ get_child_nodes ptr' \\<^sub>r children" + assumes adopt_node_document_in_heap: "heap_is_wellformed h \ known_ptrs h \ type_wf h + \ h \ ok (adopt_node owner_document node) + \ owner_document |\| document_ptr_kinds h" + assumes adopt_node_preserves_type_wf: + "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h + \ type_wf h \ type_wf h'" + assumes adopt_node_preserves_known_ptrs: + "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h + \ type_wf h \ known_ptrs h'" + lemma adopt_node_wf_is_l_adopt_node_wf [instances]: "l_adopt_node_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes @@ -4353,6 +4942,9 @@ lemma adopt_node_wf_is_l_adopt_node_wf [instances]: 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 @@ -4439,8 +5031,248 @@ locale l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub l_set_disconnected_nodes_get_ancestors + l_get_ancestors_wf + l_get_owner_document + - l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_get_owner_document_wf begin + +lemma insert_before_preserves_acyclitity_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ insert_before ptr node child \\<^sub>h h'" +shows "acyclic (parent_child_rel h')" +proof - + obtain ancestors reference_child owner_document h2 h3 + disconnected_nodes_h2 + where + ancestors: "h \ get_ancestors ptr \\<^sub>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) \\<^sub>r reference_child" and + owner_document: "h \ get_owner_document ptr \\<^sub>r owner_document" and + h2: "h \ adopt_node owner_document node \\<^sub>h h2" and + disconnected_nodes_h2: "h2 \ get_disconnected_nodes owner_document + \\<^sub>r disconnected_nodes_h2" and + h3: "h2 \ set_disconnected_nodes owner_document + (remove1 node disconnected_nodes_h2) \\<^sub>h h3" and + h': "h3 \ a_insert_node ptr node reference_child \\<^sub>h h'" + using assms(4) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) + + have "known_ptr ptr" + by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I assms + l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) + + have "type_wf h2" + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF adopt_node_writes h2] + using assms adopt_node_types_preserved + by(auto simp add: a_remove_child_locs_def reflp_def transp_def) + then have "type_wf h3" + using writes_small_big[where P="\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 insert_node_writes h'] + using set_child_nodes_types_preserved + by(auto simp add: reflp_def transp_def) + + have object_ptr_kinds_M_eq3_h: "object_ptr_kinds h = object_ptr_kinds h2" + apply(rule writes_small_big[where P="\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 \\<^sub>r ptrs = h2 \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs ) + then have object_ptr_kinds_M_eq2_h: "|h \ object_ptr_kinds_M|\<^sub>r = |h2 \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h: "|h \ node_ptr_kinds_M|\<^sub>r = |h2 \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + + have "known_ptrs h2" + using assms object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast + + have wellformed_h2: "heap_is_wellformed h2" + using adopt_node_preserves_wellformedness[OF assms(1) h2] assms by simp + + have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3" + apply(rule writes_small_big[where P="\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 \\<^sub>r ptrs = h3 \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs) + then have object_ptr_kinds_M_eq2_h2: "|h2 \ object_ptr_kinds_M|\<^sub>r = |h3 \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h2: "|h2 \ node_ptr_kinds_M|\<^sub>r = |h3 \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + have document_ptr_kinds_eq2_h2: "|h2 \ document_ptr_kinds_M|\<^sub>r = |h3 \ document_ptr_kinds_M|\<^sub>r" + using object_ptr_kinds_M_eq2_h2 document_ptr_kinds_M_eq by auto + + have "known_ptrs h3" + using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \known_ptrs h2\ by blast + + 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 \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs) + then have object_ptr_kinds_M_eq2_h3: + "|h3 \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h3: "|h3 \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + have document_ptr_kinds_eq2_h3: "|h3 \ document_ptr_kinds_M|\<^sub>r = |h' \ document_ptr_kinds_M|\<^sub>r" + using object_ptr_kinds_M_eq2_h3 document_ptr_kinds_M_eq by auto + + have "known_ptrs h'" + using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \known_ptrs h3\ by blast + + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. owner_document \ doc_ptr + \ h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" + using get_disconnected_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) + then have disconnected_nodes_eq2_h2: + "\doc_ptr. doc_ptr \ owner_document + \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" + using select_result_eq by force + have disconnected_nodes_h3: + "h3 \ get_disconnected_nodes owner_document \\<^sub>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 \\<^sub>r disc_nodes + = h' \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" + using get_disconnected_nodes_reads insert_node_writes h' + apply(rule reads_writes_preserved) + using set_child_nodes_get_disconnected_nodes by fast + then have disconnected_nodes_eq2_h3: + "\doc_ptr. |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" + using select_result_eq by force + + have children_eq_h2: + "\ptr' children. h2 \ get_child_nodes ptr' \\<^sub>r children = h3 \ get_child_nodes ptr' \\<^sub>r children" + using get_child_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (auto simp add: set_disconnected_nodes_get_child_nodes) + then have children_eq2_h2: + "\ptr'. |h2 \ get_child_nodes ptr'|\<^sub>r = |h3 \ get_child_nodes ptr'|\<^sub>r" + using select_result_eq by force + + have children_eq_h3: + "\ptr' children. ptr \ ptr' + \ h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" + using get_child_nodes_reads insert_node_writes h' + apply(rule reads_writes_preserved) + by (auto simp add: set_child_nodes_get_child_nodes_different_pointers) + then have children_eq2_h3: + "\ptr'. ptr \ ptr' \ |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" + using select_result_eq by force + obtain children_h3 where children_h3: "h3 \ get_child_nodes ptr \\<^sub>r children_h3" + using h' a_insert_node_def by auto + have children_h': "h' \ get_child_nodes ptr \\<^sub>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 \\<^sub>r children \ node \ set children" + using assms h2 adopt_node_removes_child 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|\<^sub>r" + proof - + fix d + assume "d |\| document_ptr_kinds h3" + show "node \ set |h3 \ get_disconnected_nodes d|\<^sub>r" + proof (cases "d = owner_document") + case True + then show ?thesis + using disconnected_nodes_h2 wellformed_h2 h3 remove_from_disconnected_nodes_removes + wellformed_h2 \d |\| document_ptr_kinds h3\ disconnected_nodes_h3 + by fastforce + next + case False + then have + "set |h2 \ get_disconnected_nodes d|\<^sub>r \ set |h2 \ get_disconnected_nodes owner_document|\<^sub>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 ptr \\<^sub>r ancestors_h2" + using get_ancestors_ok object_ptr_kinds_M_eq2_h2 \known_ptrs h2\ \type_wf h2\ + by (metis is_OK_returns_result_E object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2) + have ancestors_h3: "h3 \ get_ancestors ptr \\<^sub>r ancestors_h2" + using get_ancestors_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_separate_forwards) + using \heap_is_wellformed h2\ ancestors_h2 + by (auto simp add: set_disconnected_nodes_get_ancestors) + have node_not_in_ancestors_h2: "cast node \ set ancestors_h2" + apply(rule get_ancestors_remains_not_in_ancestors[OF assms(1) wellformed_h2 ancestors ancestors_h2]) + using adopt_node_children_subset using h2 \known_ptrs h\ \ type_wf h\ apply(blast) + using node_not_in_ancestors apply(blast) + using object_ptr_kinds_M_eq3_h apply(blast) + using \known_ptrs h\ apply(blast) + using \type_wf h\ apply(blast) + using \type_wf h2\ by blast + + have "acyclic (parent_child_rel h2)" + using wellformed_h2 by (simp add: heap_is_wellformed_def acyclic_heap_def) + then have "acyclic (parent_child_rel h3)" + by(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2) + moreover + + have "cast node \ {x. (x, ptr) \ (parent_child_rel h2)\<^sup>*}" + using adopt_node_removes_child + using ancestors node_not_in_ancestors + using \known_ptrs h2\ \type_wf h2\ ancestors_h2 local.get_ancestors_parent_child_rel node_not_in_ancestors_h2 wellformed_h2 + by blast + then have "cast node \ {x. (x, ptr) \ (parent_child_rel h3)\<^sup>*}" + by(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2) + moreover have "parent_child_rel h' + = insert (ptr, cast node) ((parent_child_rel h3))" + using children_h3 children_h' ptr_in_heap + apply(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h' children_eq2_h3 + insert_before_list_node_in_set)[1] + apply (metis (no_types, lifting) children_eq2_h3 insert_before_list_in_set select_result_I2) + by (metis (no_types, lifting) children_eq2_h3 imageI insert_before_list_in_set select_result_I2) + ultimately show "acyclic (parent_child_rel h')" + by (auto simp add: heap_is_wellformed_def) +qed + lemma insert_before_heap_is_wellformed_preserved: assumes wellformed: "heap_is_wellformed h" and insert_before: "h \ insert_before ptr node child \\<^sub>h h'" @@ -4684,13 +5516,14 @@ proof - children_eq_h2)[1] using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 using node_ptr_kinds_eq2_h2 apply auto[1] - by (metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq_h2 - disconnected_nodes_h2 disconnected_nodes_h3 fset_mp fset_of_list_subset - node_ptr_kinds_eq2_h2 select_result_I2 set_remove1_subset) + apply (metis \known_ptrs h2\ \type_wf h3\ children_eq_h2 local.get_child_nodes_ok local.heap_is_wellformed_children_in_heap local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h2 returns_result_select_result wellformed_h2) + by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 document_ptr_kinds_commutes finite_set_in node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h2 select_result_I2 set_remove1_subset subsetD) + have "set children_h3 \ set |h' \ node_ptr_kinds_M|\<^sub>r" using children_h3 \a_all_ptrs_in_heap h3\ apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq2_h3)[1] - by (metis (no_types, hide_lams) fset_mp fset_of_list_elem node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h') + by (metis children_eq_h2 l_heap_is_wellformed.heap_is_wellformed_children_in_heap local.l_heap_is_wellformed_axioms node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2 wellformed_h2) + then have "set (insert_before_list node reference_child children_h3) \ set |h' \ node_ptr_kinds_M|\<^sub>r" using node_in_heap apply(auto simp add: node_ptr_kinds_eq2_h node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3)[1] @@ -4702,13 +5535,10 @@ proof - apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1] using children_eq_h3 children_h' - by (metis (no_types, hide_lams) NodeMonad.ptr_kinds_ptr_kinds_M - \set (insert_before_list node reference_child children_h3) \ set |h' \ node_ptr_kinds_M|\<^sub>r\ - fset.map_comp fset_mp fset_of_list_elem node_ptr_kinds_def node_ptr_kinds_eq2_h3 - returns_result_eq subsetCE) + apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD) + by (metis (no_types) \type_wf h'\ disconnected_nodes_eq2_h3 disconnected_nodes_eq_h3 finite_set_in is_OK_returns_result_I local.get_disconnected_nodes_ok local.get_disconnected_nodes_ptr_in_heap returns_result_select_result subsetD) qed - moreover have "a_distinct_lists h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h3" @@ -4900,31 +5730,323 @@ proof - 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] - proof - - fix node_ptr - assume 0: "\node_ptr. node_ptr |\| node_ptr_kinds h' - \ (\document_ptr. document_ptr |\| document_ptr_kinds h' - \ node_ptr \ set |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) - \ (\parent_ptr. parent_ptr |\| object_ptr_kinds h' - \ node_ptr \ set |h3 \ get_child_nodes parent_ptr|\<^sub>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|\<^sub>r" - then have "(\document_ptr. document_ptr |\| document_ptr_kinds h' - \ node_ptr \ set |h2 \ get_disconnected_nodes document_ptr|\<^sub>r)" - by (metis (no_types, lifting) children_eq2_h3 children_h' children_h3 - insert_before_list_in_set select_result_I2) - then show "\document_ptr. document_ptr |\| document_ptr_kinds h' - \ node_ptr \ set |h3 \ get_disconnected_nodes document_ptr|\<^sub>r" - by (metis (no_types, hide_lams) "2" children_h' disconnected_nodes_eq2_h2 - disconnected_nodes_h2 disconnected_nodes_h3 in_set_remove1 - insert_before_list_in_set object_ptr_kinds_M_eq3_h' - ptr_in_heap select_result_I2) - qed + by (smt children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set object_ptr_kinds_M_eq3_h' ptr_in_heap select_result_I2) ultimately show "heap_is_wellformed h'" by (simp add: heap_is_wellformed_def) qed + +lemma adopt_node_children_remain_distinct_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ adopt_node owner_document node_ptr \\<^sub>h h'" +shows "\ptr' children'. + h' \ get_child_nodes ptr' \\<^sub>r children' \ distinct children'" + using assms(1) assms(2) assms(3) assms(4) local.adopt_node_preserves_wellformedness local.heap_is_wellformed_children_distinct + by blast + + +lemma insert_node_children_remain_distinct_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ a_insert_node ptr new_child reference_child_opt \\<^sub>h h'" + assumes "h \ get_child_nodes ptr \\<^sub>r children" + assumes "new_child \ set children" +shows "\children'. + h' \ get_child_nodes ptr \\<^sub>r children' \ distinct children'" +proof - + fix children' + assume a1: "h' \ get_child_nodes ptr \\<^sub>r children'" + have "h' \ get_child_nodes ptr \\<^sub>r (insert_before_list new_child reference_child_opt children)" + using assms(4) assms(5) apply(auto simp add: a_insert_node_def elim!: bind_returns_heap_E)[1] + using returns_result_eq set_child_nodes_get_child_nodes assms(2) assms(3) + by (metis is_OK_returns_result_I local.get_child_nodes_ptr_in_heap local.get_child_nodes_pure local.known_ptrs_known_ptr pure_returns_heap_eq) + moreover have "a_distinct_lists h" + using assms local.heap_is_wellformed_def by blast + then have "\children. h \ get_child_nodes ptr \\<^sub>r children + \ distinct children" + using assms local.heap_is_wellformed_children_distinct by blast + ultimately show "h' \ get_child_nodes ptr \\<^sub>r children' \ distinct children'" + using assms(5) assms(6) insert_before_list_distinct returns_result_eq by fastforce +qed + +lemma insert_before_children_remain_distinct_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ insert_before ptr new_child child_opt \\<^sub>h h'" +shows "\ptr' children'. + h' \ get_child_nodes ptr' \\<^sub>r children' \ distinct children'" +proof - + obtain reference_child owner_document h2 h3 disconnected_nodes_h2 where + reference_child: + "h \ (if Some new_child = child_opt then a_next_sibling new_child else return child_opt) \\<^sub>r reference_child" and + owner_document: "h \ get_owner_document ptr \\<^sub>r owner_document" and + h2: "h \ adopt_node owner_document new_child \\<^sub>h h2" and + disconnected_nodes_h2: "h2 \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h2" and + h3: "h2 \ set_disconnected_nodes owner_document (remove1 new_child disconnected_nodes_h2) \\<^sub>h h3" and + h': "h3 \ a_insert_node ptr new_child reference_child \\<^sub>h h'" + using assms(4) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) + + have "\ptr children. h2 \ get_child_nodes ptr \\<^sub>r children + \ distinct children" + using adopt_node_children_remain_distinct_thesis + using assms(1) assms(2) assms(3) h2 + by blast + moreover have "\ptr children. h2 \ get_child_nodes ptr \\<^sub>r children + \ new_child \ set children" + using adopt_node_removes_child + using assms(1) assms(2) assms(3) h2 + by blast + moreover have "\ptr children. h2 \ get_child_nodes ptr \\<^sub>r children = h3 \ get_child_nodes ptr \\<^sub>r children" + using get_child_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (auto simp add: set_disconnected_nodes_get_child_nodes) + ultimately show "\ptr children. h' \ get_child_nodes ptr \\<^sub>r children + \ distinct children" + using insert_node_children_remain_distinct + by (meson assms(1) assms(2) assms(3) assms(4) insert_before_heap_is_wellformed_preserved(1) local.heap_is_wellformed_children_distinct) +qed + + +lemma insert_before_removes_child_thesis: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ insert_before ptr node child \\<^sub>h h'" + assumes "ptr \ ptr'" + shows "\children'. h' \ get_child_nodes ptr' \\<^sub>r children' \ node \ set children'" +proof - + fix children' + assume a1: "h' \ get_child_nodes ptr' \\<^sub>r children'" + obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where + ancestors: "h \ get_ancestors ptr \\<^sub>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) \\<^sub>r reference_child" and + owner_document: "h \ get_owner_document ptr \\<^sub>r owner_document" and + h2: "h \ adopt_node owner_document node \\<^sub>h h2" and + disconnected_nodes_h2: "h2 \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h2" and + h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \\<^sub>h h3" and + h': "h3 \ a_insert_node ptr node reference_child \\<^sub>h h'" + using assms(4) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) + + have "known_ptr ptr" + by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I assms(2) + l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) + + have "type_wf h2" + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF adopt_node_writes h2] + using assms(3) adopt_node_types_preserved + by(auto simp add: a_remove_child_locs_def reflp_def transp_def) + then have "type_wf h3" + using writes_small_big[where P="\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 insert_node_writes h'] + using set_child_nodes_types_preserved + by(auto simp add: reflp_def transp_def) + + have object_ptr_kinds_M_eq3_h: "object_ptr_kinds h = object_ptr_kinds h2" + apply(rule writes_small_big[where P="\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 \\<^sub>r ptrs = h2 \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs ) + then have object_ptr_kinds_M_eq2_h: "|h \ object_ptr_kinds_M|\<^sub>r = |h2 \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h: "|h \ node_ptr_kinds_M|\<^sub>r = |h2 \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + + have "known_ptrs h2" + using assms object_ptr_kinds_M_eq3_h known_ptrs_preserved by blast + + have wellformed_h2: "heap_is_wellformed h2" + using adopt_node_preserves_wellformedness[OF assms(1) h2] assms by simp + + have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3" + apply(rule writes_small_big[where P="\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 \\<^sub>r ptrs = h3 \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs) + then have object_ptr_kinds_M_eq2_h2: "|h2 \ object_ptr_kinds_M|\<^sub>r = |h3 \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h2: "|h2 \ node_ptr_kinds_M|\<^sub>r = |h3 \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + have document_ptr_kinds_eq2_h2: "|h2 \ document_ptr_kinds_M|\<^sub>r = |h3 \ document_ptr_kinds_M|\<^sub>r" + using object_ptr_kinds_M_eq2_h2 document_ptr_kinds_M_eq by auto + + have "known_ptrs h3" + using object_ptr_kinds_M_eq3_h2 known_ptrs_preserved \known_ptrs h2\ by blast + + 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 \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs) + then have object_ptr_kinds_M_eq2_h3: + "|h3 \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" + by simp + then have node_ptr_kinds_eq2_h3: "|h3 \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + have document_ptr_kinds_eq2_h3: "|h3 \ document_ptr_kinds_M|\<^sub>r = |h' \ document_ptr_kinds_M|\<^sub>r" + using object_ptr_kinds_M_eq2_h3 document_ptr_kinds_M_eq by auto + + have "known_ptrs h'" + using object_ptr_kinds_M_eq3_h' known_ptrs_preserved \known_ptrs h3\ by blast + + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. owner_document \ doc_ptr + \ h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" + using get_disconnected_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) + then have disconnected_nodes_eq2_h2: + "\doc_ptr. doc_ptr \ owner_document + \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" + using select_result_eq by force + have disconnected_nodes_h3: + "h3 \ get_disconnected_nodes owner_document \\<^sub>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 \\<^sub>r disc_nodes + = h' \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" + using get_disconnected_nodes_reads insert_node_writes h' + apply(rule reads_writes_preserved) + using set_child_nodes_get_disconnected_nodes by fast + then have disconnected_nodes_eq2_h3: + "\doc_ptr. |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" + using select_result_eq by force + + have children_eq_h2: + "\ptr' children. h2 \ get_child_nodes ptr' \\<^sub>r children = h3 \ get_child_nodes ptr' \\<^sub>r children" + using get_child_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (auto simp add: set_disconnected_nodes_get_child_nodes) + then have children_eq2_h2: + "\ptr'. |h2 \ get_child_nodes ptr'|\<^sub>r = |h3 \ get_child_nodes ptr'|\<^sub>r" + using select_result_eq by force + + have children_eq_h3: + "\ptr' children. ptr \ ptr' + \ h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" + using get_child_nodes_reads insert_node_writes h' + apply(rule reads_writes_preserved) + by (auto simp add: set_child_nodes_get_child_nodes_different_pointers) + then have children_eq2_h3: + "\ptr'. ptr \ ptr' \ |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" + using select_result_eq by force + obtain children_h3 where children_h3: "h3 \ get_child_nodes ptr \\<^sub>r children_h3" + using h' a_insert_node_def by auto + have children_h': "h' \ get_child_nodes ptr \\<^sub>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 \\<^sub>r children \ node \ set children" + using assms(1) assms(2) assms(3) h2 local.adopt_node_removes_child by blast + show "node \ set children'" + using a1 assms(5) child_not_in_any_children children_eq_h2 children_eq_h3 by blast +qed + +lemma ensure_pre_insertion_validity_ok: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "ptr |\| object_ptr_kinds h" + assumes "\is_character_data_ptr_kind parent" + assumes "cast node \ set |h \ get_ancestors parent|\<^sub>r" + assumes "h \ get_parent ref \\<^sub>r Some parent" + assumes "is_document_ptr parent \ h \ get_child_nodes parent \\<^sub>r []" + assumes "is_document_ptr parent \ \is_character_data_ptr_kind node" + shows "h \ ok (a_ensure_pre_insertion_validity node parent (Some ref))" +proof - + have "h \ (if is_character_data_ptr_kind parent + then error HierarchyRequestError else return ()) \\<^sub>r ()" + using assms + by (simp add: assms(4)) + moreover have "h \ do { + ancestors \ get_ancestors parent; + (if cast node \ set ancestors then error HierarchyRequestError else return ()) + } \\<^sub>r ()" + using assms(6) + apply(auto intro!: bind_pure_returns_result_I)[1] + using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap by auto + + moreover have "h \ do { + (case Some ref of + Some child \ do { + child_parent \ get_parent child; + (if child_parent \ Some parent then error NotFoundError else return ())} + | None \ return ()) + } \\<^sub>r ()" + using assms(7) + by(auto split: option.splits) + moreover have "h \ do { + children \ get_child_nodes parent; + (if children \ [] \ is_document_ptr parent + then error HierarchyRequestError else return ()) + } \\<^sub>r ()" + using assms(8) + by (smt assms(5) assms(7) bind_pure_returns_result_I2 calculation(1) is_OK_returns_result_I local.get_child_nodes_pure local.get_parent_child_dual returns_result_eq) + + moreover have "h \ do { + (if is_character_data_ptr node \ is_document_ptr parent + then error HierarchyRequestError else return ()) + } \\<^sub>r ()" + using assms + using is_character_data_ptr_kind_none by force + ultimately show ?thesis + unfolding a_ensure_pre_insertion_validity_def + apply(intro bind_is_OK_pure_I) + apply auto[1] + apply auto[1] + apply auto[1] + using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap + apply blast + apply auto[1] + apply auto[1] + using assms(6) + apply auto[1] + using assms(1) assms(2) assms(3) assms(7) local.get_ancestors_ok local.get_parent_parent_in_heap + apply auto[1] + apply (smt bind_returns_heap_E is_OK_returns_heap_E local.get_parent_pure pure_def + pure_returns_heap_eq return_returns_heap returns_result_eq) + apply(blast) + using local.get_child_nodes_pure + apply blast + apply (meson assms(7) is_OK_returns_result_I local.get_parent_child_dual) + apply (simp) + apply (smt assms(5) assms(8) is_OK_returns_result_I returns_result_eq) + by(auto) +qed end locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs @@ -4957,14 +6079,471 @@ lemma insert_before_wf2_is_l_insert_before_wf2 [instances]: using insert_before_heap_is_wellformed_preserved apply(fast, fast, fast) done + + +locale l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = + l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_remove_child_wf2 +begin + +lemma next_sibling_ok: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "node_ptr |\| node_ptr_kinds h" + shows "h \ ok (a_next_sibling node_ptr)" +proof - + have "known_ptr (cast node_ptr)" + using assms(2) assms(4) local.known_ptrs_known_ptr node_ptr_kinds_commutes by blast + then show ?thesis + using assms + apply(auto simp add: a_next_sibling_def intro!: bind_is_OK_pure_I split: option.splits list.splits) + using get_child_nodes_ok local.get_parent_parent_in_heap local.known_ptrs_known_ptr by blast +qed + +lemma remove_child_ok: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "h \ get_child_nodes ptr \\<^sub>r children" + assumes "child \ set children" + shows "h \ ok (remove_child ptr child)" +proof - + + have "ptr |\| object_ptr_kinds h" + using assms(4) local.get_child_nodes_ptr_in_heap by blast + have "child |\| node_ptr_kinds h" + using assms(1) assms(4) assms(5) local.heap_is_wellformed_children_in_heap by blast + have "\is_character_data_ptr ptr" + proof (rule ccontr, simp) + assume "is_character_data_ptr ptr" + then have "h \ get_child_nodes ptr \\<^sub>r []" + using \ptr |\| object_ptr_kinds h\ + apply(simp add: get_child_nodes_def a_get_child_nodes_tups_def) + apply(split invoke_splits)+ + by(auto simp add: get_child_nodes\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_pure_returns_result_I split: option.splits) + then + show False + using assms returns_result_eq by fastforce + qed + have "is_character_data_ptr child \ \is_document_ptr_kind ptr" + proof (rule ccontr, simp) + assume "is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child" + and "is_document_ptr_kind ptr" + then show False + using assms + using \ptr |\| object_ptr_kinds h\ + apply(simp add: get_child_nodes_def a_get_child_nodes_tups_def) + apply(split invoke_splits)+ + apply(auto split: option.splits) + apply (meson invoke_empty is_OK_returns_result_I) + apply (meson invoke_empty is_OK_returns_result_I) + by(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits) + qed + + obtain owner_document where + owner_document: "h \ get_owner_document (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r owner_document" + by (meson \child |\| node_ptr_kinds h\ assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_owner_document_ok node_ptr_kinds_commutes) + obtain disconnected_nodes_h where + disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" + by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap owner_document) + obtain h2 where + h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" + by (meson assms(1) assms(2) assms(3) is_OK_returns_heap_E l_set_disconnected_nodes.set_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap local.l_set_disconnected_nodes_axioms owner_document) + + have "known_ptr ptr" + using assms(2) assms(4) local.known_ptrs_known_ptr + using \ptr |\| object_ptr_kinds h\ by blast + + have "type_wf h2" + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h2] + using set_disconnected_nodes_types_preserved assms(3) + by(auto simp add: reflp_def transp_def) + + have "object_ptr_kinds h = object_ptr_kinds h2" + using h2 + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF set_disconnected_nodes_writes]) + using set_disconnected_nodes_pointers_preserved + by (auto simp add: reflp_def transp_def) + + have "h2 \ ok (set_child_nodes ptr (remove1 child children))" + proof (cases "is_element_ptr_kind ptr") + case True + then show ?thesis + using set_child_nodes_element_ok \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ assms(4) + using \ptr |\| object_ptr_kinds h\ by blast + next + case False + then have "is_document_ptr_kind ptr" + using \known_ptr ptr\ \ptr |\| object_ptr_kinds h\ \\is_character_data_ptr ptr\ + by(auto simp add:known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + moreover have "is_document_ptr ptr" + using \known_ptr ptr\ \ptr |\| object_ptr_kinds h\ False \\is_character_data_ptr ptr\ + by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + ultimately show ?thesis + using assms(4) + apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def) + apply(split invoke_splits)+ + apply(auto elim!: bind_returns_result_E2 split: option.splits) + apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits) + using \ptr |\| object_ptr_kinds h\ \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ assms(4) local.set_child_nodes_document1_ok apply blast + using \ptr |\| object_ptr_kinds h\ \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ assms(4) local.set_child_nodes_document1_ok apply blast + using \ptr |\| object_ptr_kinds h\ \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ assms(4) is_element_ptr_kind_cast local.set_child_nodes_document2_ok by blast + qed + then + obtain h' where + h': "h2 \ set_child_nodes ptr (remove1 child children) \\<^sub>h h'" + by auto + + show ?thesis + using assms + apply(auto simp add: remove_child_def + simp add: is_OK_returns_heap_I[OF h2] is_OK_returns_heap_I[OF h'] is_OK_returns_result_I[OF assms(4)] is_OK_returns_result_I[OF owner_document] is_OK_returns_result_I[OF disconnected_nodes_h] + intro!: bind_is_OK_pure_I[OF get_owner_document_pure] + bind_is_OK_pure_I[OF get_child_nodes_pure] + bind_is_OK_pure_I[OF get_disconnected_nodes_pure] + bind_is_OK_I[rotated, OF h2] + dest!: returns_result_eq[OF assms(4)] returns_result_eq[OF owner_document] returns_result_eq[OF disconnected_nodes_h] +) + using h2 returns_result_select_result by force +qed + +lemma adopt_node_ok: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "document_ptr |\| document_ptr_kinds h" + assumes "child |\| node_ptr_kinds h" + shows "h \ ok (adopt_node document_ptr child)" +proof - + obtain old_document where + old_document: "h \ get_owner_document (cast child) \\<^sub>r old_document" + by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E local.get_owner_document_ok node_ptr_kinds_commutes) + then have "h \ ok (get_owner_document (cast child))" + by auto + obtain parent_opt where + parent_opt: "h \ get_parent child \\<^sub>r parent_opt" + by (meson assms(2) assms(3) is_OK_returns_result_I l_get_owner_document.get_owner_document_ptr_in_heap + local.get_parent_ok local.l_get_owner_document_axioms node_ptr_kinds_commutes old_document + returns_result_select_result) + then have "h \ ok (get_parent child)" + by auto + + have "h \ ok (case parent_opt of Some parent \ remove_child parent child | None \ return ())" + apply(auto split: option.splits)[1] + using remove_child_ok + by (metis assms(1) assms(2) assms(3) local.get_parent_child_dual parent_opt) + then + obtain h2 where + h2: "h \ (case parent_opt of Some parent \ remove_child parent child | None \ return ()) \\<^sub>h h2" + by auto + + have "object_ptr_kinds h = object_ptr_kinds h2" + using h2 apply(simp split: option.splits) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes]) + using remove_child_pointers_preserved + by (auto simp add: reflp_def transp_def) + then + have "old_document |\| document_ptr_kinds h2" + using assms(1) assms(2) assms(3) document_ptr_kinds_commutes local.get_owner_document_owner_document_in_heap old_document by blast + + + have wellformed_h2: "heap_is_wellformed h2" + using h2 remove_child_heap_is_wellformed_preserved assms + by(auto split: option.splits) + have "type_wf h2" + using h2 remove_child_preserves_type_wf assms + by(auto split: option.splits) + have "known_ptrs h2" + using h2 remove_child_preserves_known_ptrs assms + by(auto split: option.splits) + + + have "object_ptr_kinds h = object_ptr_kinds h2" + using h2 apply(simp split: option.splits) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes]) + using remove_child_pointers_preserved + by (auto simp add: reflp_def transp_def) + then have "document_ptr_kinds h = document_ptr_kinds h2" + by(auto simp add: document_ptr_kinds_def) + + have "h2 \ ok (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 () + })" + proof(cases "document_ptr = old_document") + case True + then show ?thesis + by simp + next + case False + then have "h2 \ ok (get_disconnected_nodes old_document)" + by (simp add: \old_document |\| document_ptr_kinds h2\ \type_wf h2\ local.get_disconnected_nodes_ok) + then obtain old_disc_nodes where + old_disc_nodes: "h2 \ get_disconnected_nodes old_document \\<^sub>r old_disc_nodes" + by auto + + have "h2 \ ok (set_disconnected_nodes old_document (remove1 child old_disc_nodes))" + by (simp add: \old_document |\| document_ptr_kinds h2\ \type_wf h2\ local.set_disconnected_nodes_ok) + then obtain h3 where + h3: "h2 \ set_disconnected_nodes old_document (remove1 child old_disc_nodes) \\<^sub>h h3" + by auto + + + have object_ptr_kinds_h2_eq3: "object_ptr_kinds h2 = object_ptr_kinds h3" + apply(rule writes_small_big[where P="\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 \\<^sub>r ptrs = h3 \ object_ptr_kinds_M \\<^sub>r ptrs" + by(simp add: object_ptr_kinds_M_defs) + then have object_ptr_kinds_eq_h2: "|h2 \ object_ptr_kinds_M|\<^sub>r = |h3 \ object_ptr_kinds_M|\<^sub>r" + by(simp) + then have node_ptr_kinds_eq_h2: "|h2 \ node_ptr_kinds_M|\<^sub>r = |h3 \ node_ptr_kinds_M|\<^sub>r" + using node_ptr_kinds_M_eq by blast + then have node_ptr_kinds_eq3_h2: "node_ptr_kinds h2 = node_ptr_kinds h3" + by auto + have document_ptr_kinds_eq2_h2: "|h2 \ document_ptr_kinds_M|\<^sub>r = |h3 \ document_ptr_kinds_M|\<^sub>r" + using object_ptr_kinds_eq_h2 document_ptr_kinds_M_eq by auto + then have document_ptr_kinds_eq3_h2: "document_ptr_kinds h2 = document_ptr_kinds h3" + using object_ptr_kinds_eq_h2 document_ptr_kinds_M_eq by auto + have children_eq_h2: + "\ptr children. h2 \ get_child_nodes ptr \\<^sub>r children = h3 \ get_child_nodes ptr \\<^sub>r children" + using get_child_nodes_reads set_disconnected_nodes_writes h3 + apply(rule reads_writes_preserved) + by (simp add: set_disconnected_nodes_get_child_nodes) + then have children_eq2_h2: "\ptr. |h2 \ get_child_nodes ptr|\<^sub>r = |h3 \ get_child_nodes ptr|\<^sub>r" + using select_result_eq by force + + have "type_wf h3" + using \type_wf h2\ + 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) + moreover have "document_ptr |\| document_ptr_kinds h3" + using \document_ptr_kinds h = document_ptr_kinds h2\ assms(4) document_ptr_kinds_eq3_h2 by auto + ultimately have "h3 \ ok (get_disconnected_nodes document_ptr)" + by (simp add: local.get_disconnected_nodes_ok) + + then obtain disc_nodes where + disc_nodes: "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" + by auto + + + have "h3 \ ok (set_disconnected_nodes document_ptr (child # disc_nodes))" + using \document_ptr |\| document_ptr_kinds h3\ \type_wf h3\ local.set_disconnected_nodes_ok by auto + then obtain h' where + h': "h3 \ set_disconnected_nodes document_ptr (child # disc_nodes) \\<^sub>h h'" + by auto + + then show ?thesis + using False + using \h2 \ ok get_disconnected_nodes old_document\ + using \h3 \ ok get_disconnected_nodes document_ptr\ + apply(auto dest!: returns_result_eq[OF old_disc_nodes] returns_result_eq[OF disc_nodes] + intro!: bind_is_OK_I[rotated, OF h3] bind_is_OK_pure_I[OF get_disconnected_nodes_pure] ) + using \h2 \ ok set_disconnected_nodes old_document (remove1 child old_disc_nodes)\ by auto + qed + then obtain h' where + 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 () + }) \\<^sub>h h'" + by auto + + show ?thesis + using \h \ ok (get_owner_document (cast child))\ + using \h \ ok (get_parent child)\ + using h2 h' + apply(auto simp add: adopt_node_def + simp add: is_OK_returns_heap_I[OF h2] + intro!: bind_is_OK_pure_I[OF get_owner_document_pure] + bind_is_OK_pure_I[OF get_parent_pure] + bind_is_OK_I[rotated, OF h2] + dest!: returns_result_eq[OF parent_opt] returns_result_eq[OF old_document]) + using \h \ ok (case parent_opt of None \ return () | Some parent \ remove_child parent child)\ + by auto +qed + +lemma insert_node_ok: + assumes "known_ptr parent" and "type_wf h" + assumes "parent |\| object_ptr_kinds h" + assumes "\is_character_data_ptr_kind parent" + assumes "is_document_ptr parent \ h \ get_child_nodes parent \\<^sub>r []" + assumes "is_document_ptr parent \ \is_character_data_ptr_kind node" + assumes "known_ptr (cast node)" + shows "h \ ok (a_insert_node parent node ref)" +proof(auto simp add: a_insert_node_def get_child_nodes_ok[OF assms(1) assms(2) assms(3)] intro!: bind_is_OK_pure_I) + fix children' + assume "h \ get_child_nodes parent \\<^sub>r children'" + + show "h \ ok set_child_nodes parent (insert_before_list node ref children')" + proof (cases "is_element_ptr_kind parent") + case True + then show ?thesis + using set_child_nodes_element_ok + using assms(1) assms(2) assms(3) by blast + next + case False + then have "is_document_ptr_kind parent" + using assms(4) assms(1) + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then have "is_document_ptr parent" + using assms(1) + by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) + then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" and "children = []" + using assms(5) by blast + + have "insert_before_list node ref children' = [node]" + by (metis \children = []\ \h \ get_child_nodes parent \\<^sub>r children'\ append.left_neutral children insert_Nil l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.insert_before_list.elims l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.insert_before_list.simps(3) neq_Nil_conv returns_result_eq) + moreover have "\is_character_data_ptr_kind node" + using \is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r parent\ assms(6) by blast + then have "is_element_ptr_kind node" + by (metis (no_types, lifting) CharacterDataClass.a_known_ptr_def DocumentClass.a_known_ptr_def ElementClass.a_known_ptr_def NodeClass.a_known_ptr_def assms(7) cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject document_ptr_no_node_ptr_cast is_character_data_ptr_kind_none is_document_ptr_kind_none is_element_ptr_implies_kind is_node_ptr_kind_cast local.known_ptr_impl node_ptr_casts_commute3 option.case_eq_if) + ultimately + show ?thesis + using set_child_nodes_document2_ok + by (metis \is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r parent\ assms(1) assms(2) assms(3) assms(5) is_document_ptr_kind_none option.case_eq_if) + qed +qed + +lemma insert_before_ok: + assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h" + assumes "parent |\| object_ptr_kinds h" + assumes "node |\| node_ptr_kinds h" + assumes "\is_character_data_ptr_kind parent" + assumes "cast node \ set |h \ get_ancestors parent|\<^sub>r" + assumes "h \ get_parent ref \\<^sub>r Some parent" + assumes "is_document_ptr parent \ h \ get_child_nodes parent \\<^sub>r []" + assumes "is_document_ptr parent \ \is_character_data_ptr_kind node" + shows "h \ ok (insert_before parent node (Some ref))" +proof - + have "h \ ok (a_ensure_pre_insertion_validity node parent (Some ref))" + using assms ensure_pre_insertion_validity_ok by blast + have "h \ ok (if Some node = Some ref + then a_next_sibling node + else return (Some ref))" (is "h \ ok ?P") + apply(auto split: if_splits)[1] + using assms(1) assms(2) assms(3) assms(5) next_sibling_ok by blast + + then obtain reference_child where + reference_child: "h \ ?P \\<^sub>r reference_child" + by auto + + obtain owner_document where + owner_document: "h \ get_owner_document parent \\<^sub>r owner_document" + using assms get_owner_document_ok + by (meson returns_result_select_result) + then have "h \ ok (get_owner_document parent)" + by auto + have "owner_document |\| document_ptr_kinds h" + using assms(1) assms(2) assms(3) local.get_owner_document_owner_document_in_heap owner_document by blast + + obtain h2 where + h2: "h \ adopt_node owner_document node \\<^sub>h h2" + by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_heap_E adopt_node_ok l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms + local.get_owner_document_owner_document_in_heap owner_document) + then have "h \ ok (adopt_node owner_document node)" + by auto + have "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 "document_ptr_kinds h = document_ptr_kinds h2" + by(auto simp add: document_ptr_kinds_def) + have "heap_is_wellformed h2" + using h2 adopt_node_preserves_wellformedness assms by blast + have "known_ptrs h2" + using h2 adopt_node_preserves_known_ptrs assms by blast + have "type_wf h2" + using h2 adopt_node_preserves_type_wf assms by blast + + obtain disconnected_nodes_h2 where + disconnected_nodes_h2: "h2 \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h2" + by (metis \document_ptr_kinds h = document_ptr_kinds h2\ \type_wf h2\ assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_owner_document_owner_document_in_heap owner_document) + + obtain h3 where + h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \\<^sub>h h3" + by (metis \document_ptr_kinds h = document_ptr_kinds h2\ \owner_document |\| document_ptr_kinds h\ \type_wf h2\ document_ptr_kinds_def is_OK_returns_heap_E l_set_disconnected_nodes.set_disconnected_nodes_ok local.l_set_disconnected_nodes_axioms) + + have "type_wf h3" + using \type_wf h2\ + 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) + + 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) + + have "parent |\| object_ptr_kinds h3" + using \object_ptr_kinds h = object_ptr_kinds h2\ assms(4) object_ptr_kinds_M_eq3_h2 by blast + moreover have "known_ptr parent" + using assms(2) assms(4) local.known_ptrs_known_ptr by blast + moreover have "known_ptr (cast node)" + using assms(2) assms(5) local.known_ptrs_known_ptr node_ptr_kinds_commutes by blast + moreover have "is_document_ptr parent \ h3 \ get_child_nodes parent \\<^sub>r []" + by (metis assms(8) assms(9) distinct.simps(2) distinct_singleton local.get_parent_child_dual returns_result_eq) + ultimately obtain h' where + h': "h3 \ a_insert_node parent node reference_child \\<^sub>h h'" + using insert_node_ok \type_wf h3\ assms by blast + + show ?thesis + using \h \ ok (a_ensure_pre_insertion_validity node parent (Some ref))\ + using reference_child \h \ ok (get_owner_document parent)\ \h \ ok (adopt_node owner_document node)\ h3 h' + apply(auto simp add: insert_before_def + simp add: is_OK_returns_result_I[OF disconnected_nodes_h2] + simp add: is_OK_returns_heap_I[OF h3] is_OK_returns_heap_I[OF h'] + intro!: bind_is_OK_I2 + bind_is_OK_pure_I[OF ensure_pre_insertion_validity_pure] + bind_is_OK_pure_I[OF next_sibling_pure] + bind_is_OK_pure_I[OF get_owner_document_pure] + bind_is_OK_pure_I[OF get_disconnected_nodes_pure] + dest!: returns_result_eq[OF owner_document] returns_result_eq[OF disconnected_nodes_h2] returns_heap_eq[OF h2] returns_heap_eq[OF h3] + dest!: sym[of node ref] + ) + using returns_result_eq by fastforce +qed +end + +interpretation i_insert_before_wf3?: l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + get_parent get_parent_locs get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors get_ancestors_locs adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_owner_document insert_before insert_before_locs append_child type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel remove_child remove_child_locs get_root_node get_root_node_locs remove + by(auto simp add: l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) +declare l_insert_before_wf3\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] + + locale l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_insert_before_wf2 + + l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_insert_before_wf + + l_insert_before_wf2 + l_get_child_nodes begin + +lemma append_child_heap_is_wellformed_preserved: + assumes wellformed: "heap_is_wellformed h" + and append_child: "h \ append_child ptr node \\<^sub>h h'" + and known_ptrs: "known_ptrs h" + and type_wf: "type_wf h" + shows "heap_is_wellformed h'" and "type_wf h'" and "known_ptrs h'" + using assms + by(auto simp add: append_child_def intro: insert_before_preserves_type_wf insert_before_preserves_known_ptrs insert_before_heap_is_wellformed_preserved) + lemma append_child_children: assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" assumes "h \ get_child_nodes ptr \\<^sub>r xs" @@ -5087,6 +6666,17 @@ lemma append_child_for_all_on_no_children: by force end +locale l_append_child_wf = l_type_wf + l_known_ptrs + l_append_child_defs + l_heap_is_wellformed_defs + + assumes append_child_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ append_child ptr child \\<^sub>h h' + \ type_wf h'" + assumes append_child_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ append_child ptr child \\<^sub>h h' + \ known_ptrs h'" + assumes append_child_heap_is_wellformed_preserved: + "type_wf h \ known_ptrs h \ heap_is_wellformed h \ h \ append_child ptr child \\<^sub>h h' + \ heap_is_wellformed h'" + interpretation i_append_child_wf?: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs @@ -5098,6 +6688,9 @@ interpretation i_append_child_wf?: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^s parent_child_rel by(auto simp add: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) +lemma append_child_wf_is_l_append_child_wf [instances]: "l_append_child_wf type_wf known_ptr known_ptrs append_child heap_is_wellformed" + apply(auto simp add: l_append_child_wf_def l_append_child_wf_axioms_def instances)[1] + using append_child_heap_is_wellformed_preserved by fast+ subsection \create\_element\ @@ -5110,7 +6703,7 @@ locale l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub l_set_tag_type_get_disconnected_nodes type_wf set_tag_type set_tag_type_locs get_disconnected_nodes get_disconnected_nodes_locs + l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs set_tag_type set_tag_type_locs create_element + + set_disconnected_nodes_locs set_tag_type set_tag_type_locs type_wf create_element known_ptr + l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_tag_type_get_child_nodes type_wf set_tag_type set_tag_type_locs known_ptr get_child_nodes get_child_nodes_locs + @@ -5141,7 +6734,7 @@ lemma create_element_preserves_wellformedness: and "h \ create_element document_ptr tag \\<^sub>h h'" and "type_wf h" and "known_ptrs h" - shows "heap_is_wellformed 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 \\<^sub>r new_element_ptr" and @@ -5153,6 +6746,11 @@ proof - by(auto simp add: create_element_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + then have "h \ create_element document_ptr tag \\<^sub>r new_element_ptr" + apply(auto simp add: create_element_def intro!: bind_returns_result_I)[1] + apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust) + apply (metis is_OK_returns_heap_E is_OK_returns_result_I local.get_disconnected_nodes_pure pure_returns_heap_eq) + by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust) have "new_element_ptr \ set |h \ element_ptr_kinds_M|\<^sub>r" using new_element_ptr ElementMonad.ptr_kinds_ptr_kinds_M h2 @@ -5198,6 +6796,19 @@ proof - using object_ptr_kinds_eq_h3 by(auto simp add: node_ptr_kinds_def) + have "known_ptr (cast new_element_ptr)" + using \h \ create_element document_ptr tag \\<^sub>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 @@ -5250,7 +6861,7 @@ proof - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_tag_type_writes h3] using set_tag_type_types_preserved by(auto simp add: reflp_def transp_def) - then have "type_wf h'" + 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) @@ -5282,7 +6893,7 @@ proof - using \heap_is_wellformed h\ using \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ a_all_ptrs_in_heap_def heap_is_wellformed_def - by (meson NodeMonad.ptr_kinds_ptr_kinds_M fset_mp fset_of_list_elem ) + 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\ @@ -5328,21 +6939,12 @@ proof - 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)[1] - using node_ptr_kinds_eq_h - \cast new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - \h2 \ get_child_nodes (cast new_element_ptr) \\<^sub>r []\ - apply (metis (no_types, hide_lams) children_eq_h fempty_iff fset_mp fset_of_list_simps(1) - funionCI select_result_I2) - by (simp add: disconnected_nodes_eq_h fset_rev_mp node_ptr_kinds_eq_h) + apply (metis \known_ptrs h2\ \parent_child_rel h = parent_child_rel h2\ \type_wf h2\ assms(1) assms(3) funion_iff local.get_child_nodes_ok local.known_ptrs_known_ptr local.parent_child_rel_child_in_heap local.parent_child_rel_child_nodes2 node_ptr_kinds_commutes node_ptr_kinds_eq_h returns_result_select_result) + by (metis assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funion_iff local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h returns_result_select_result) then have "a_all_ptrs_in_heap h3" - by(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_eq_h2 node_ptr_kinds_def - children_eq_h2 disconnected_nodes_eq_h2) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_eq_h3 node_ptr_kinds_def children_eq_h3 )[1] - using disconnected_nodes_eq_h3 object_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - by (metis (no_types, lifting) disc_nodes_h3 finsertCI fset.map_comp fset_mp fset_of_list_elem - funion_finsert_right h' local.set_disconnected_nodes_get_disconnected_nodes - node_ptr_kinds_def node_ptr_kinds_eq_h select_result_I2 set_ConsD) + by (smt \h2 \ get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr) \\<^sub>r []\ children_eq2_h3 disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 finite_set_in h' is_OK_returns_result_I l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes local.a_all_ptrs_in_heap_def local.get_child_nodes_ptr_in_heap local.l_set_disconnected_nodes_get_disconnected_nodes_axioms node_ptr_kinds_commutes object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1)) have "\p. p |\| object_ptr_kinds h \ cast new_element_ptr \ set |h \ get_child_nodes p|\<^sub>r" using \heap_is_wellformed h\ \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ @@ -5411,24 +7013,18 @@ proof - ultimately show "False" apply(-) apply(cases "x = document_ptr") - apply (metis (no_types) NodeMonad.ptr_kinds_ptr_kinds_M - \a_all_ptrs_in_heap h\ - \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def assms(3) disc_nodes_h3 disconnected_nodes_eq2_h - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal - document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 fset_mp fset_of_list_elem - get_disconnected_nodes_ok h' returns_result_select_result select_result_I2 - set_ConsD set_disconnected_nodes_get_disconnected_nodes) - apply(cases "y = document_ptr" ) - apply (metis (no_types) NodeMonad.ptr_kinds_ptr_kinds_M - \a_all_ptrs_in_heap h\ - \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def assms(3) disc_nodes_h3 disconnected_nodes_eq2_h - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal - document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 fset_mp fset_of_list_elem - get_disconnected_nodes_ok h' returns_result_select_result select_result_I2 - set_ConsD set_disconnected_nodes_get_disconnected_nodes) - using disconnected_nodes_eq2_h3 by auto + apply (smt NodeMonad.ptr_kinds_ptr_kinds_M \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ \local.a_all_ptrs_in_heap h\ + disc_nodes_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 + disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h' + l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes + local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms + select_result_I2 set_ConsD subsetD) + by (smt NodeMonad.ptr_kinds_ptr_kinds_M \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ \local.a_all_ptrs_in_heap h\ + disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 + disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h' + l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes + local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms + select_result_I2 set_ConsD subsetD) next fix x xa xb assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) @@ -5467,27 +7063,8 @@ proof - 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) - proof - - fix node_ptr :: "(_) node_ptr" - assume a1: "\node_ptr. node_ptr |\| node_ptr_kinds h \ (\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r) \ (\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" - assume a2: "node_ptr |\| node_ptr_kinds h" - assume a3: "\parent_ptr. (parent_ptr = cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ node_ptr \ set |h' \ get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr)|\<^sub>r) \ (parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h' \ get_child_nodes parent_ptr|\<^sub>r)" - assume a4: "document_ptr |\| document_ptr_kinds h" - assume a5: "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" - obtain dd :: "(_) node_ptr \ (_) document_ptr" where - "\x0. (\v1. v1 |\| document_ptr_kinds h \ x0 \ set |h \ get_disconnected_nodes v1|\<^sub>r) = (dd x0 |\| document_ptr_kinds h \ x0 \ set |h \ get_disconnected_nodes (dd x0)|\<^sub>r)" - by moura - then have f6: "dd node_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes (dd node_ptr)|\<^sub>r" - using a3 a2 a1 by (metis (no_types) \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2_h children_eq2_h2 children_eq2_h3 l_ptr_kinds_M.ptr_kinds_ptr_kinds_M object_ptr_kinds_M_def) - moreover - { assume "|h \ get_disconnected_nodes (dd node_ptr)|\<^sub>r \ disc_nodes_h3" - then have "document_ptr \ dd node_ptr" - using a5 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 by force - then have "\d. d |\| document_ptr_kinds h2 \ node_ptr \ set |h' \ get_disconnected_nodes d|\<^sub>r" - using f6 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h by auto } - ultimately show "\d. d |\| document_ptr_kinds h2 \ node_ptr \ set |h' \ get_disconnected_nodes d|\<^sub>r" - using a4 by (metis (no_types) document_ptr_kinds_eq_h h' insert_iff list.set(2) local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) - qed + by(metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>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 finite_set_in h' l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms node_ptr_kinds_commutes select_result_I2) + show "heap_is_wellformed h'" using \a_acyclic_heap h'\ \a_all_ptrs_in_heap h'\ \a_distinct_lists h'\ \a_owner_document_valid h'\ by(simp add: heap_is_wellformed_def) @@ -5515,8 +7092,8 @@ locale l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub> + l_set_val_get_disconnected_nodes type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs create_character_data + get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs set_val set_val_locs type_wf create_character_data known_ptr + l_new_character_data_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_val_get_child_nodes @@ -5555,7 +7132,7 @@ lemma create_character_data_preserves_wellformedness: and "h \ create_character_data document_ptr text \\<^sub>h h'" and "type_wf h" and "known_ptrs h" - shows "heap_is_wellformed 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 \\<^sub>r new_character_data_ptr" and @@ -5567,6 +7144,12 @@ proof - by(auto simp add: create_character_data_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + then + have "h \ create_character_data document_ptr text \\<^sub>r new_character_data_ptr" + apply(auto simp add: create_character_data_def intro!: bind_returns_result_I) + apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust) + apply (metis is_OK_returns_heap_E is_OK_returns_result_I local.get_disconnected_nodes_pure pure_returns_heap_eq) + by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust) have "new_character_data_ptr \ set |h \ character_data_ptr_kinds_M|\<^sub>r" @@ -5729,7 +7312,7 @@ proof - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_val_writes h3] using set_val_types_preserved by(auto simp add: reflp_def transp_def) - then have "type_wf h'" + 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) @@ -5759,7 +7342,7 @@ proof - 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|\<^sub>r\ a_all_ptrs_in_heap_def heap_is_wellformed_def - by (meson NodeMonad.ptr_kinds_ptr_kinds_M fset_mp fset_of_list_elem ) + 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\ @@ -5806,20 +7389,23 @@ proof - apply(auto simp add: a_all_ptrs_in_heap_def)[1] using node_ptr_kinds_eq_h \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ - apply (metis (no_types, hide_lams) children_eq_h fempty_iff fset_mp fset_of_list_simps(1) - funionCI select_result_I2) - by (simp add: disconnected_nodes_eq_h fset_rev_mp node_ptr_kinds_eq_h) + apply (metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \parent_child_rel h = parent_child_rel h2\ + children_eq2_h finite_set_in finsert_iff funion_finsert_right local.parent_child_rel_child + local.parent_child_rel_parent_in_heap node_ptr_kinds_commutes object_ptr_kinds_eq_h + select_result_I2 subsetD sup_bot.right_neutral) + by (metis assms(1) assms(3) disconnected_nodes_eq2_h document_ptr_kinds_eq_h funionI1 + local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap + node_ptr_kinds_eq_h returns_result_select_result) then have "a_all_ptrs_in_heap h3" - by(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_eq_h2 node_ptr_kinds_def - children_eq_h2 disconnected_nodes_eq_h2) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_eq_h3 node_ptr_kinds_def - children_eq_h3 )[1] - using disconnected_nodes_eq_h3 object_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - by (metis (no_types, lifting) disc_nodes_h3 finsertCI fset.map_comp fset_mp fset_of_list_elem - funion_finsert_right h' local.set_disconnected_nodes_get_disconnected_nodes - node_ptr_kinds_def node_ptr_kinds_eq_h select_result_I2 set_ConsD) - + by (smt character_data_ptr_kinds_commutes children_eq2_h3 disc_nodes_document_ptr_h2 + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 + finite_set_in h' h2 local.a_all_ptrs_in_heap_def + local.set_disconnected_nodes_get_disconnected_nodes new_character_data_ptr + new_character_data_ptr_in_heap node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 + object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1)) have "\p. p |\| object_ptr_kinds h \ cast new_character_data_ptr \ set |h \ get_child_nodes p|\<^sub>r" using \heap_is_wellformed h\ \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ heap_is_wellformed_children_in_heap @@ -5882,25 +7468,13 @@ proof - moreover have "set |h3 \ get_disconnected_nodes x|\<^sub>r \ set |h3 \ get_disconnected_nodes y|\<^sub>r = {}" using calculation by(auto dest: distinct_concat_map_E(1)) ultimately show "False" - apply(cases "x = document_ptr") - apply (metis (no_types) NodeMonad.ptr_kinds_ptr_kinds_M \a_all_ptrs_in_heap h\ - \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def assms(3) disc_nodes_h3 - disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 - disconnected_nodes_eq2_h3 disjoint_iff_not_equal - document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 fset_mp - fset_of_list_elem get_disconnected_nodes_ok h' - returns_result_select_result select_result_I2 set_ConsD - set_disconnected_nodes_get_disconnected_nodes) - apply(cases "y = document_ptr" ) - apply (metis (no_types) NodeMonad.ptr_kinds_ptr_kinds_M - \a_all_ptrs_in_heap h\ \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def assms(3) disc_nodes_h3 disconnected_nodes_eq2_h - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal - document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 fset_mp fset_of_list_elem - get_disconnected_nodes_ok h' returns_result_select_result select_result_I2 set_ConsD - set_disconnected_nodes_get_disconnected_nodes) - using disconnected_nodes_eq2_h3 by auto + by (smt NodeMonad.ptr_kinds_ptr_kinds_M \cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ + \local.a_all_ptrs_in_heap h\ disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal + document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h' + l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes + local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms + select_result_I2 set_ConsD subsetD) next fix x xa xb assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) @@ -5936,10 +7510,25 @@ proof - apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) apply(simp add: object_ptr_kinds_eq_h) - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M - \cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ - children_eq2_h disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h h' list.set_intros(2) - local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) + by (metis (mono_tags, lifting) \cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ + children_eq2_h disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h' + l_ptr_kinds_M.ptr_kinds_ptr_kinds_M + l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes + list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms object_ptr_kinds_M_def + select_result_I2) + + have "known_ptr (cast new_character_data_ptr)" + using \h \ create_character_data document_ptr text \\<^sub>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 show "heap_is_wellformed h'" using \a_acyclic_heap h'\ \a_all_ptrs_in_heap h'\ \a_distinct_lists h'\ \a_owner_document_valid h'\ @@ -5953,6 +7542,7 @@ interpretation i_create_character_data_wf?: l_create_character_data_wf\<^sub>C\< set_disconnected_nodes_locs create_character_data known_ptrs using instances by (auto simp add: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) +declare l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] subsection \create\_document\ @@ -6098,22 +7688,20 @@ proof - 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 h'" + then have "a_all_ptrs_in_heap h'" apply(auto simp add: a_all_ptrs_in_heap_def)[1] - apply (metis ObjectMonad.ptr_kinds_ptr_kinds_M - \cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ - \parent_child_rel h = parent_child_rel h'\ assms(1) children_eq fset_of_list_elem - local.heap_is_wellformed_children_in_heap local.parent_child_rel_child - local.parent_child_rel_parent_in_heap node_ptr_kinds_eq) - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M - \cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ - \h' \ get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \\<^sub>r []\ - \parent_child_rel h = parent_child_rel h'\ assms(1) disconnected_nodes_eq_h - fset_of_list_elem h' local.heap_is_wellformed_disc_nodes_in_heap - local.new_document_no_disconnected_nodes local.parent_child_rel_child - local.parent_child_rel_parent_in_heap new_document_ptr node_ptr_kinds_eq - select_result_I2) - + using ObjectMonad.ptr_kinds_ptr_kinds_M + \cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ + \parent_child_rel h = parent_child_rel h'\ assms(1) children_eq fset_of_list_elem + local.heap_is_wellformed_children_in_heap local.parent_child_rel_child + local.parent_child_rel_parent_in_heap node_ptr_kinds_eq + apply (metis (no_types, lifting) \h' \ get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \\<^sub>r []\ + children_eq2 finite_set_in finsert_iff funion_finsert_right object_ptr_kinds_eq select_result_I2 subsetD sup_bot.right_neutral) + by (metis (no_types, lifting) \cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr |\| object_ptr_kinds h\ + \h' \ get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \\<^sub>r []\ + \h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []\ \parent_child_rel h = parent_child_rel h'\ \type_wf h'\ assms(1) disconnected_nodes_eq_h local.get_disconnected_nodes_ok + local.heap_is_wellformed_disc_nodes_in_heap local.parent_child_rel_child local.parent_child_rel_parent_in_heap + node_ptr_kinds_eq returns_result_select_result select_result_I2) have "a_distinct_lists h" using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) @@ -6182,12 +7770,7 @@ proof - then have "a_owner_document_valid h'" apply(auto simp add: a_owner_document_valid_def)[1] by (metis \cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr |\| object_ptr_kinds h\ - \new_document_ptr |\| document_ptr_kinds h\ assms(3) assms(4) children_eq - children_eq2 disconnected_nodes_eq2_h disconnected_nodes_eq_h - is_OK_returns_result_E is_OK_returns_result_I local.get_child_nodes_ok - local.get_child_nodes_ptr_in_heap local.get_disconnected_nodes_ok - local.get_disconnected_nodes_ptr_in_heap local.known_ptrs_known_ptr node_ptr_kinds_eq) - + children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in funion_iff node_ptr_kinds_eq object_ptr_kinds_eq) show "heap_is_wellformed h'" using \a_acyclic_heap h'\ \a_all_ptrs_in_heap h'\ \a_distinct_lists h'\ \a_owner_document_valid h'\ by(simp add: heap_is_wellformed_def) diff --git a/Core_DOM/classes/ElementClass.thy b/Core_DOM/standard/classes/ElementClass.thy similarity index 95% rename from Core_DOM/classes/ElementClass.thy rename to Core_DOM/standard/classes/ElementClass.thy index 02538f4..8128245 100644 --- a/Core_DOM/classes/ElementClass.thy +++ b/Core_DOM/standard/classes/ElementClass.thy @@ -31,8 +31,8 @@ section\Element\ text\In this theory, we introduce the types for the Element class.\ theory ElementClass imports - NodeClass - "../pointers/ShadowRootPointer" + "NodeClass" + "ShadowRootPointer" begin text\The type @{type "DOMString"} is a type synonym for @{type "string"}, define in \autoref{sec:Core_DOM_Basic_Datatypes}.\ @@ -68,6 +68,7 @@ type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) heap" register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) heap" +type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" definition element_ptr_kinds :: "(_) heap \ (_) element_ptr fset" where @@ -131,8 +132,8 @@ locale l_type_wf_def\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t begin definition a_type_wf :: "(_) heap \ bool" where - "a_type_wf h = (NodeClass.type_wf h \ (\element_ptr. element_ptr |\| element_ptr_kinds h - \ get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h \ None))" + "a_type_wf h = (NodeClass.type_wf h \ (\element_ptr \ fset (element_ptr_kinds h). + get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h \ None))" end global_interpretation l_type_wf_def\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t defines type_wf = a_type_wf . lemmas type_wf_defs = a_type_wf_def @@ -154,7 +155,7 @@ lemma get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf: shows "element_ptr |\| element_ptr_kinds h \ get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h \ None" using l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_axioms assms apply(simp add: type_wf_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) - by (metis NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf bind_eq_None_conv element_ptr_kinds_commutes + by (metis NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf bind_eq_None_conv element_ptr_kinds_commutes notin_fset option.distinct(1)) end @@ -273,7 +274,6 @@ lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>E\<^ using assms by(auto simp add: new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def) - locale l_known_ptr\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t begin definition a_known_ptr :: "(_) object_ptr \ bool" @@ -291,21 +291,24 @@ locale l_known_ptrs\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t = l_ begin definition a_known_ptrs :: "(_) heap \ bool" where - "a_known_ptrs h = (\ptr. ptr |\| object_ptr_kinds h \ known_ptr ptr)" + "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" lemma known_ptrs_known_ptr: "ptr |\| object_ptr_kinds h \ a_known_ptrs h \ known_ptr ptr" - by(simp add: a_known_ptrs_def) + apply(simp add: a_known_ptrs_def) + using notin_fset by fastforce lemma known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \ a_known_ptrs h = a_known_ptrs h'" by(auto simp add: a_known_ptrs_def) lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" - by(auto simp add: a_known_ptrs_def) + by(simp add: a_known_ptrs_def less_eq_fset.rep_eq subsetD) +lemma known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\| {|new_ptr|} \ known_ptr new_ptr \ a_known_ptrs h \ a_known_ptrs h'" + by(simp add: a_known_ptrs_def) end global_interpretation l_known_ptrs\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t known_ptr defines known_ptrs = a_known_ptrs . lemmas known_ptrs_defs = a_known_ptrs_def lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs" - using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset by blast + using known_ptrs_known_ptr known_ptrs_preserved known_ptrs_subset known_ptrs_new_ptr l_known_ptrs_def by blast end diff --git a/Core_DOM/pointers/ShadowRootPointer.thy b/Core_DOM/standard/pointers/ShadowRootPointer.thy similarity index 95% rename from Core_DOM/pointers/ShadowRootPointer.thy rename to Core_DOM/standard/pointers/ShadowRootPointer.thy index 83f719b..97ead41 100644 --- a/Core_DOM/pointers/ShadowRootPointer.thy +++ b/Core_DOM/standard/pointers/ShadowRootPointer.thy @@ -34,7 +34,7 @@ We only include them here, as they are required for future work and they cannot following the object-oriented extensibility of our data model.\ theory ShadowRootPointer imports - DocumentPointer + "DocumentPointer" begin datatype 'shadow_root_ptr shadow_root_ptr = Ref (the_ref: ref) | Ext 'shadow_root_ptr @@ -46,6 +46,10 @@ type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr) object_ptr" +definition cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) shadow_root_ptr \ (_) shadow_root_ptr" + where + "cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r = id" + definition cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_)shadow_root_ptr \ (_) object_ptr" where "cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = object_ptr.Ext (Inr (Inr (Inl ptr)))" @@ -56,7 +60,7 @@ definition cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\ object_ptr.Ext (Inr (Inr (Inl shadow_root_ptr))) \ Some shadow_root_ptr | _ \ None)" -adhoc_overloading cast cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r +adhoc_overloading cast cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r definition is_shadow_root_ptr_kind :: "(_) object_ptr \ bool"