From f955f2fa565c99a59ab26567a4a6c2c81773f3a7 Mon Sep 17 00:00:00 2001 From: Michael Herzberg Date: Wed, 22 Jul 2020 22:11:21 +0100 Subject: [PATCH] Fixed long lines and simp lemmas without names. --- Core_DOM/Core_DOM/common/Core_DOM.thy | 2 +- .../common/Core_DOM_Basic_Datatypes.thy | 14 +- .../Core_DOM/common/Core_DOM_Functions.thy | 2000 ++++---- Core_DOM/Core_DOM/common/Core_DOM_Tests.thy | 2 +- .../Core_DOM/common/classes/BaseClass.thy | 30 +- .../common/classes/CharacterDataClass.thy | 95 +- .../Core_DOM/common/classes/DocumentClass.thy | 99 +- .../Core_DOM/common/classes/NodeClass.thy | 51 +- .../Core_DOM/common/classes/ObjectClass.thy | 56 +- Core_DOM/Core_DOM/common/monads/BaseMonad.thy | 58 +- .../common/monads/CharacterDataMonad.thy | 323 +- .../Core_DOM/common/monads/DocumentMonad.thy | 361 +- .../Core_DOM/common/monads/ElementMonad.thy | 198 +- Core_DOM/Core_DOM/common/monads/NodeMonad.thy | 56 +- .../Core_DOM/common/monads/ObjectMonad.thy | 56 +- .../common/pointers/CharacterDataPointer.thy | 54 +- .../common/pointers/DocumentPointer.thy | 32 +- .../common/pointers/ElementPointer.thy | 50 +- .../Core_DOM/common/pointers/NodePointer.thy | 24 +- .../common/pointers/ObjectPointer.thy | 8 +- Core_DOM/Core_DOM/common/pointers/Ref.thy | 8 +- .../common/preliminaries/Heap_Error_Monad.thy | 179 +- .../preliminaries/Hiding_Type_Variables.thy | 284 +- .../common/preliminaries/Testing_Utils.thy | 14 +- .../common/tests/Core_DOM_BaseTest.thy | 51 +- .../common/tests/Document_adoptNode.thy | 2 +- .../common/tests/Document_getElementById.thy | 2 +- .../common/tests/Node_insertBefore.thy | 2 +- .../common/tests/Node_removeChild.thy | 2 +- .../Core_DOM/standard/Core_DOM_Heap_WF.thy | 4294 +++++++++-------- .../standard/classes/ElementClass.thy | 98 +- .../standard/pointers/ShadowRootPointer.thy | 48 +- .../safely_composable/Core_DOM_Heap_WF.thy | 3667 +++++++------- .../classes/ElementClass.thy | 97 +- .../pointers/ShadowRootPointer.thy | 82 +- 35 files changed, 6466 insertions(+), 5933 deletions(-) diff --git a/Core_DOM/Core_DOM/common/Core_DOM.thy b/Core_DOM/Core_DOM/common/Core_DOM.thy index 6b48724..e0f5e54 100644 --- a/Core_DOM/Core_DOM/common/Core_DOM.thy +++ b/Core_DOM/Core_DOM/common/Core_DOM.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/common/Core_DOM_Basic_Datatypes.thy b/Core_DOM/Core_DOM/common/Core_DOM_Basic_Datatypes.thy index fa409d9..bec3b9c 100644 --- a/Core_DOM/Core_DOM/common/Core_DOM_Basic_Datatypes.thy +++ b/Core_DOM/Core_DOM/common/Core_DOM_Basic_Datatypes.thy @@ -23,7 +23,7 @@ * 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 *******************************************************************************\***) @@ -31,7 +31,7 @@ section\Basic Data Types\ text\ \label{sec:Core_DOM_Basic_Datatypes} This theory formalizes the primitive data types used by the DOM standard~\cite{dom-specification}. -\ +\ theory Core_DOM_Basic_Datatypes imports Main @@ -39,16 +39,16 @@ begin type_synonym USVString = string text\ - In the official standard, the type @{type "USVString"} corresponds to the set of all possible + In the official standard, the type @{type "USVString"} corresponds to the set of all possible sequences of Unicode scalar values. As we are not interested in analyzing the specifics of Unicode strings, we just model @{type "USVString"} using the standard type @{type "string"} of Isabelle/HOL. -\ +\ type_synonym DOMString = string text\ - In the official standard, the type @{type "DOMString"} corresponds to the set of all possible - sequences of code units, commonly interpreted as UTF-16 encoded strings. Again, as we are not - interested in analyzing the specifics of Unicode strings, we just model @{type "DOMString"} using + In the official standard, the type @{type "DOMString"} corresponds to the set of all possible + sequences of code units, commonly interpreted as UTF-16 encoded strings. Again, as we are not + interested in analyzing the specifics of Unicode strings, we just model @{type "DOMString"} using the standard type @{type "string"} of Isabelle/HOL. \ diff --git a/Core_DOM/Core_DOM/common/Core_DOM_Functions.thy b/Core_DOM/Core_DOM/common/Core_DOM_Functions.thy index 5bbe4f5..c81e765 100644 --- a/Core_DOM/Core_DOM/common/Core_DOM_Functions.thy +++ b/Core_DOM/Core_DOM/common/Core_DOM_Functions.thy @@ -23,17 +23,17 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Querying and Modifying the DOM\ -text\In this theory, we are formalizing the functions for querying and modifying +text\In this theory, we are formalizing the functions for querying and modifying the DOM.\ theory Core_DOM_Functions -imports - "monads/DocumentMonad" + imports + "monads/DocumentMonad" begin text \If we do not declare show\_variants, then all abbreviations that contain @@ -46,9 +46,9 @@ lemma insort_split: "x \ set (insort y xs) \ (x = y \ y \ set (concat (map f xs)) \ \!x \ set xs. y \ set (f x)" - apply(induct xs) + apply(induct xs) by(auto) lemma concat_map_all_distinct: "distinct (concat (map f xs)) \ x \ set xs \ distinct (f x)" @@ -58,10 +58,10 @@ lemma concat_map_all_distinct: "distinct (concat (map f xs)) \ x lemma distinct_concat_map_I: assumes "distinct xs" and "\x. x \ set xs \ distinct (f x)" -and "\x y. x \ set xs \ y \ set xs \ x \ y \ (set (f x)) \ (set (f y)) = {}" -shows "distinct (concat ((map f xs)))" + and "\x y. x \ set xs \ y \ set xs \ x \ y \ (set (f x)) \ (set (f y)) = {}" + shows "distinct (concat ((map f xs)))" using assms - apply(induct xs) + apply(induct xs) by(auto) lemma distinct_concat_map_E: @@ -69,15 +69,15 @@ lemma distinct_concat_map_E: shows "\x y. x \ set xs \ y \ set xs \ x \ y \ (set (f x)) \ (set (f y)) = {}" and "\x. x \ set xs \ distinct (f x)" using assms - apply(induct xs) + apply(induct xs) by(auto) lemma bind_is_OK_E3 [elim]: assumes "h \ ok (f \ g)" and "pure f h" obtains x where "h \ f \\<^sub>r x" and "h \ ok (g x)" - using assms + using assms by(auto simp add: bind_def returns_result_def returns_heap_def is_OK_def execute_def pure_def - split: sum.splits) + split: sum.splits) subsection \Basic Functions\ @@ -119,7 +119,7 @@ definition a_get_child_nodes :: "(_) object_ptr \ (_, (_) node_ptr l definition a_get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" where - "a_get_child_nodes_locs ptr \ + "a_get_child_nodes_locs ptr \ (if is_element_ptr_kind ptr then {preserved (get_M (the (cast ptr)) RElement.child_nodes)} else {}) \ (if is_document_ptr_kind ptr then {preserved (get_M (the (cast ptr)) RDocument.document_element)} else {}) \ {preserved (get_M ptr RObject.nothing)}" @@ -137,13 +137,13 @@ locale l_get_child_nodes_defs = locale l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_type_wf type_wf + - l_known_ptr known_ptr + + l_known_ptr known_ptr + l_get_child_nodes_defs get_child_nodes get_child_nodes_locs + l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and get_child_nodes :: "(_) object_ptr \ (_, (_) node_ptr list) dom_prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + + and known_ptr :: "(_) object_ptr \ bool" + and get_child_nodes :: "(_) object_ptr \ (_, (_) node_ptr list) dom_prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + assumes known_ptr_impl: "known_ptr = DocumentClass.known_ptr" assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes get_child_nodes_impl: "get_child_nodes = a_get_child_nodes" @@ -156,19 +156,19 @@ lemma get_child_nodes_split: "P (invoke (a_get_child_nodes_tups @ xs) ptr ()) = ((known_ptr ptr \ P (get_child_nodes ptr)) \ (\(known_ptr ptr) \ P (invoke xs ptr ())))" - by(auto simp add: known_ptr_impl get_child_nodes_impl a_get_child_nodes_def a_get_child_nodes_tups_def - known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs - NodeClass.known_ptr_defs - split: invoke_splits) + by(auto simp add: known_ptr_impl get_child_nodes_impl a_get_child_nodes_def a_get_child_nodes_tups_def + known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs + NodeClass.known_ptr_defs + split: invoke_splits) lemma get_child_nodes_split_asm: "P (invoke (a_get_child_nodes_tups @ xs) ptr ()) = (\((known_ptr ptr \ \P (get_child_nodes ptr)) \ (\(known_ptr ptr) \ \P (invoke xs ptr ()))))" - by(auto simp add: known_ptr_impl get_child_nodes_impl a_get_child_nodes_def - a_get_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs - ElementClass.known_ptr_defs NodeClass.known_ptr_defs - split: invoke_splits) + by(auto simp add: known_ptr_impl get_child_nodes_impl a_get_child_nodes_def + a_get_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs + ElementClass.known_ptr_defs NodeClass.known_ptr_defs + split: invoke_splits) lemmas get_child_nodes_splits = get_child_nodes_split get_child_nodes_split_asm @@ -180,49 +180,49 @@ lemma get_child_nodes_ok [simp]: using assms(1) assms(2) assms(3) apply(auto simp add: known_ptr_impl type_wf_impl get_child_nodes_def a_get_child_nodes_tups_def)[1] apply(split invoke_splits, rule conjI)+ - apply((rule impI)+, drule(1) known_ptr_not_document_ptr, drule(1) known_ptr_not_character_data_ptr, - drule(1) known_ptr_not_element_ptr) + apply((rule impI)+, drule(1) known_ptr_not_document_ptr, drule(1) known_ptr_not_character_data_ptr, + drule(1) known_ptr_not_element_ptr) apply(auto simp add: NodeClass.known_ptr_defs)[1] - apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def dest: get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok - split: list.splits option.splits intro!: bind_is_OK_I2)[1] - apply(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)[1] - apply (auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CharacterDataClass.type_wf_defs - DocumentClass.type_wf_defs intro!: bind_is_OK_I2 split: option.splits)[1] + apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def dest: get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok + split: list.splits option.splits intro!: bind_is_OK_I2)[1] + apply(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)[1] + apply (auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CharacterDataClass.type_wf_defs + DocumentClass.type_wf_defs intro!: bind_is_OK_I2 split: option.splits)[1] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok \type_wf h\[unfolded type_wf_impl] by blast lemma get_child_nodes_ptr_in_heap [simp]: assumes "h \ get_child_nodes ptr \\<^sub>r children" shows "ptr |\| object_ptr_kinds h" using assms - by(auto simp add: get_child_nodes_impl a_get_child_nodes_def invoke_ptr_in_heap - dest: is_OK_returns_result_I) + by(auto simp add: get_child_nodes_impl a_get_child_nodes_def invoke_ptr_in_heap + dest: is_OK_returns_result_I) lemma get_child_nodes_pure [simp]: "pure (get_child_nodes ptr) h" apply (auto simp add: get_child_nodes_impl a_get_child_nodes_def a_get_child_nodes_tups_def)[1] apply(split invoke_splits, rule conjI)+ - 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 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 - get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_pure_I split: option.splits) + 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 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 + get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro!: bind_pure_I split: option.splits) lemma get_child_nodes_reads: "reads (get_child_nodes_locs ptr) (get_child_nodes ptr) h h'" - apply(simp add: get_child_nodes_locs_impl get_child_nodes_impl a_get_child_nodes_def - a_get_child_nodes_tups_def a_get_child_nodes_locs_def) + apply(simp add: get_child_nodes_locs_impl get_child_nodes_impl a_get_child_nodes_def + a_get_child_nodes_tups_def a_get_child_nodes_locs_def) apply(split invoke_splits, rule conjI)+ - apply(auto)[1] - apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: reads_subset[OF reads_singleton] - reads_subset[OF check_in_heap_reads] + apply(auto)[1] + apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: reads_subset[OF reads_singleton] + reads_subset[OF check_in_heap_reads] intro!: reads_bind_pure reads_subset[OF return_reads] split: option.splits)[1] (* slow: ca 1min *) - apply(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: reads_subset[OF check_in_heap_reads] + apply(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: reads_subset[OF check_in_heap_reads] intro!: reads_bind_pure reads_subset[OF return_reads] )[1] - apply(auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: reads_subset[OF reads_singleton] - reads_subset[OF check_in_heap_reads] intro!: reads_bind_pure reads_subset[OF return_reads] + apply(auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: reads_subset[OF reads_singleton] + reads_subset[OF check_in_heap_reads] intro!: reads_bind_pure reads_subset[OF return_reads] split: option.splits)[1] done end locale l_get_child_nodes = l_type_wf + l_known_ptr + l_get_child_nodes_defs + assumes get_child_nodes_reads: "reads (get_child_nodes_locs ptr) (get_child_nodes ptr) h h'" - assumes get_child_nodes_ok: "type_wf h \ known_ptr ptr \ ptr |\| object_ptr_kinds h + assumes get_child_nodes_ok: "type_wf h \ known_ptr ptr \ ptr |\| object_ptr_kinds h \ h \ ok (get_child_nodes ptr)" assumes get_child_nodes_ptr_in_heap: "h \ ok (get_child_nodes ptr) \ ptr |\| object_ptr_kinds h" assumes get_child_nodes_pure [simp]: "pure (get_child_nodes ptr) h" @@ -237,7 +237,7 @@ interpretation by(auto simp add: l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def get_child_nodes_def get_child_nodes_locs_def) declare l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_child_nodes_is_l_get_child_nodes [instances]: +lemma get_child_nodes_is_l_get_child_nodes [instances]: "l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs" apply(unfold_locales) using get_child_nodes_reads get_child_nodes_ok get_child_nodes_ptr_in_heap get_child_nodes_pure @@ -249,35 +249,35 @@ paragraph \new\_element\ locale l_new_element_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs for type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptr :: "(_) object_ptr \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_child_nodes_new_element: - "ptr' \ cast new_element_ptr \ h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' +lemma get_child_nodes_new_element: + "ptr' \ cast new_element_ptr \ h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" - by (auto simp add: get_child_nodes_locs_def new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t - new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits - elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains) + by (auto simp add: get_child_nodes_locs_def new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t + new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits + elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains) lemma new_element_no_child_nodes: - "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' + "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ h' \ get_child_nodes (cast new_element_ptr) \\<^sub>r []" - apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def + apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1] apply(split invoke_splits, rule conjI)+ apply(auto intro: new_element_is_element_ptr)[1] - by(auto simp add: new_element_ptr_in_heap get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def check_in_heap_def - new_element_child_nodes intro!: bind_pure_returns_result_I + by(auto simp add: new_element_ptr_in_heap get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def check_in_heap_def + new_element_child_nodes intro!: bind_pure_returns_result_I intro: new_element_is_element_ptr elim!: new_element_ptr_in_heap) end locale l_new_element_get_child_nodes = l_new_element + l_get_child_nodes + - assumes get_child_nodes_new_element: - "ptr' \ cast new_element_ptr \ h \ new_element \\<^sub>r new_element_ptr + assumes get_child_nodes_new_element: + "ptr' \ cast new_element_ptr \ h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" - assumes new_element_no_child_nodes: - "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' + assumes new_element_no_child_nodes: + "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ h' \ get_child_nodes (cast new_element_ptr) \\<^sub>r []" interpretation i_new_element_get_child_nodes?: @@ -285,7 +285,7 @@ interpretation i_new_element_get_child_nodes?: by(unfold_locales) declare l_new_element_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma new_element_get_child_nodes_is_l_new_element_get_child_nodes [instances]: +lemma new_element_get_child_nodes_is_l_new_element_get_child_nodes [instances]: "l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs" using new_element_is_l_new_element get_child_nodes_is_l_get_child_nodes apply(auto simp add: l_new_element_get_child_nodes_def l_new_element_get_child_nodes_axioms_def)[1] @@ -298,38 +298,38 @@ paragraph \new\_character\_data\ locale l_new_character_data_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs for type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptr :: "(_) object_ptr \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_child_nodes_new_character_data: - "ptr' \ cast new_character_data_ptr \ h \ new_character_data \\<^sub>r new_character_data_ptr +lemma get_child_nodes_new_character_data: + "ptr' \ cast new_character_data_ptr \ h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" - by (auto simp add: get_child_nodes_locs_def new_character_data_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t - new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t new_character_data_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t - split: prod.splits if_splits option.splits - elim!: bind_returns_result_E bind_returns_heap_E - intro: is_character_data_ptr_kind_obtains) + by (auto simp add: get_child_nodes_locs_def new_character_data_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t + new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t new_character_data_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t + split: prod.splits if_splits option.splits + elim!: bind_returns_result_E bind_returns_heap_E + intro: is_character_data_ptr_kind_obtains) lemma new_character_data_no_child_nodes: - "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' + "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ h' \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []" - apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def - split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1] + apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def + split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1] apply(split invoke_splits, rule conjI)+ apply(auto intro: new_character_data_is_character_data_ptr)[1] - by(auto simp add: new_character_data_ptr_in_heap 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 - check_in_heap_def new_character_data_child_nodes - intro!: bind_pure_returns_result_I - intro: new_character_data_is_character_data_ptr elim!: new_character_data_ptr_in_heap) + by(auto simp add: new_character_data_ptr_in_heap 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 + check_in_heap_def new_character_data_child_nodes + intro!: bind_pure_returns_result_I + intro: new_character_data_is_character_data_ptr elim!: new_character_data_ptr_in_heap) end locale l_new_character_data_get_child_nodes = l_new_character_data + l_get_child_nodes + - assumes get_child_nodes_new_character_data: - "ptr' \ cast new_character_data_ptr \ h \ new_character_data \\<^sub>r new_character_data_ptr + assumes get_child_nodes_new_character_data: + "ptr' \ cast new_character_data_ptr \ h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" - assumes new_character_data_no_child_nodes: - "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' + assumes new_character_data_no_child_nodes: + "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ h' \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []" interpretation i_new_character_data_get_child_nodes?: @@ -337,7 +337,7 @@ interpretation i_new_character_data_get_child_nodes?: by(unfold_locales) declare l_new_character_data_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma new_character_data_get_child_nodes_is_l_new_character_data_get_child_nodes [instances]: +lemma new_character_data_get_child_nodes_is_l_new_character_data_get_child_nodes [instances]: "l_new_character_data_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs" using new_character_data_is_l_new_character_data get_child_nodes_is_l_get_child_nodes apply(simp add: l_new_character_data_get_child_nodes_def l_new_character_data_get_child_nodes_axioms_def) @@ -351,38 +351,38 @@ paragraph \new\_document\ locale l_new_document_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs for type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptr :: "(_) object_ptr \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_child_nodes_new_document: - "ptr' \ cast new_document_ptr \ h \ new_document \\<^sub>r new_document_ptr +lemma get_child_nodes_new_document: + "ptr' \ cast new_document_ptr \ h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" by (auto simp add: get_child_nodes_locs_def new_document_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t - new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits - elim!: bind_returns_result_E bind_returns_heap_E - intro: is_document_ptr_kind_obtains) + new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits + elim!: bind_returns_result_E bind_returns_heap_E + intro: is_document_ptr_kind_obtains) lemma new_document_no_child_nodes: - "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' + "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []" - apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def - split: prod.splits + apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def + split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1] apply(split invoke_splits, rule conjI)+ apply(auto intro: new_document_is_document_ptr)[1] - by(auto simp add: new_document_ptr_in_heap 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 check_in_heap_def - new_document_document_element - intro!: bind_pure_returns_result_I + by(auto simp add: new_document_ptr_in_heap 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 check_in_heap_def + new_document_document_element + intro!: bind_pure_returns_result_I intro: new_document_is_document_ptr elim!: new_document_ptr_in_heap split: option.splits) end locale l_new_document_get_child_nodes = l_new_document + l_get_child_nodes + - assumes get_child_nodes_new_document: - "ptr' \ cast new_document_ptr \ h \ new_document \\<^sub>r new_document_ptr + assumes get_child_nodes_new_document: + "ptr' \ cast new_document_ptr \ h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" - assumes new_document_no_child_nodes: - "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' + assumes new_document_no_child_nodes: + "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []" interpretation i_new_document_get_child_nodes?: @@ -390,7 +390,7 @@ interpretation i_new_document_get_child_nodes?: by(unfold_locales) declare l_new_document_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma new_document_get_child_nodes_is_l_new_document_get_child_nodes [instances]: +lemma new_document_get_child_nodes_is_l_new_document_get_child_nodes [instances]: "l_new_document_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs" using new_document_is_l_new_document get_child_nodes_is_l_get_child_nodes apply(simp add: l_new_document_get_child_nodes_def l_new_document_get_child_nodes_axioms_def) @@ -401,12 +401,12 @@ subsubsection \set\_child\_nodes\ locale l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs begin -definition set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: +definition set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) element_ptr \ (_) node_ptr list \ (_, unit) dom_prog" where - "set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr children = put_M element_ptr RElement.child_nodes_update children" + "set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr children = put_M element_ptr RElement.child_nodes_update children" -definition set_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 :: +definition set_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 :: "(_) character_data_ptr \ (_) node_ptr list \ (_, unit) dom_prog" where "set_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 _ _ = error HierarchyRequestError" @@ -422,7 +422,7 @@ definition set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub | _ \ error HierarchyRequestError) }" -definition a_set_child_nodes_tups :: +definition a_set_child_nodes_tups :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ (_) node_ptr list \ (_, unit) dom_prog)) list" where "a_set_child_nodes_tups \ [ @@ -438,10 +438,10 @@ lemmas set_child_nodes_defs = a_set_child_nodes_def definition a_set_child_nodes_locs :: "(_) object_ptr \ (_, unit) dom_prog set" where - "a_set_child_nodes_locs ptr \ - (if is_element_ptr_kind ptr + "a_set_child_nodes_locs ptr \ + (if is_element_ptr_kind ptr then all_args (put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t (the (cast ptr)) RElement.child_nodes_update) else {}) \ - (if is_document_ptr_kind ptr + (if is_document_ptr_kind ptr then all_args (put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t (the (cast ptr)) document_element_update) else {})" end @@ -451,13 +451,13 @@ locale l_set_child_nodes_defs = locale l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_type_wf type_wf + - l_known_ptr known_ptr + + l_known_ptr known_ptr + l_set_child_nodes_defs set_child_nodes set_child_nodes_locs + - l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ (_, unit) dom_prog" - and set_child_nodes_locs :: "(_) object_ptr \ (_, unit) dom_prog set" + + and known_ptr :: "(_) object_ptr \ bool" + and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ (_, unit) dom_prog" + and set_child_nodes_locs :: "(_) object_ptr \ (_, unit) dom_prog set" + assumes known_ptr_impl: "known_ptr = DocumentClass.known_ptr" assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes set_child_nodes_impl: "set_child_nodes = a_set_child_nodes" @@ -470,34 +470,34 @@ lemma set_child_nodes_split: "P (invoke (a_set_child_nodes_tups @ xs) ptr (children)) = ((known_ptr ptr \ P (set_child_nodes ptr children)) \ (\(known_ptr ptr) \ P (invoke xs ptr (children))))" - by(auto simp add: known_ptr_impl set_child_nodes_impl a_set_child_nodes_def - a_set_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs - ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: invoke_splits) + by(auto simp add: known_ptr_impl set_child_nodes_impl a_set_child_nodes_def + a_set_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs + ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: invoke_splits) lemma set_child_nodes_split_asm: "P (invoke (a_set_child_nodes_tups @ xs) ptr (children)) = (\((known_ptr ptr \ \P (set_child_nodes ptr children)) \ (\(known_ptr ptr) \ \P (invoke xs ptr (children)))))" - by(auto simp add: known_ptr_impl set_child_nodes_impl a_set_child_nodes_def - a_set_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs - ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: invoke_splits)[1] + by(auto simp add: known_ptr_impl set_child_nodes_impl a_set_child_nodes_def + a_set_child_nodes_tups_def known_ptr_defs CharacterDataClass.known_ptr_defs + ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: invoke_splits)[1] lemmas set_child_nodes_splits = set_child_nodes_split set_child_nodes_split_asm lemma set_child_nodes_writes: "writes (set_child_nodes_locs ptr) (set_child_nodes ptr children) h h'" - apply(simp add: set_child_nodes_locs_impl set_child_nodes_impl a_set_child_nodes_def + apply(simp add: set_child_nodes_locs_impl set_child_nodes_impl a_set_child_nodes_def a_set_child_nodes_tups_def a_set_child_nodes_locs_def) apply(split invoke_splits, rule conjI)+ apply(auto)[1] - apply(auto simp add: 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 intro!: writes_bind_pure - intro: writes_union_right_I split: list.splits)[1] + apply(auto simp add: 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 intro!: writes_bind_pure + intro: writes_union_right_I split: list.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] apply(auto intro: writes_union_right_I split: option.splits)[1] (*slow: ca. 1min *) - apply(auto simp add: set_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!: writes_bind_pure)[1] - apply(auto simp add: 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 intro: writes_union_left_I + apply(auto simp add: set_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!: writes_bind_pure)[1] + apply(auto simp add: 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 intro: writes_union_left_I intro!: writes_bind_pure split: list.splits option.splits)[1] done @@ -506,8 +506,8 @@ lemma set_child_nodes_pointers_preserved: assumes "h \ w \\<^sub>h h'" shows "object_ptr_kinds h = object_ptr_kinds h'" using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)] - by(auto simp add: set_child_nodes_locs_impl all_args_def a_set_child_nodes_locs_def - split: if_splits) + by(auto simp add: set_child_nodes_locs_impl all_args_def a_set_child_nodes_locs_def + split: if_splits) lemma set_child_nodes_typess_preserved: assumes "w \ set_child_nodes_locs object_ptr" @@ -515,16 +515,16 @@ lemma set_child_nodes_typess_preserved: shows "type_wf h = type_wf h'" using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)] by(auto simp add: set_child_nodes_locs_impl type_wf_impl all_args_def a_set_child_nodes_locs_def - split: if_splits) + split: if_splits) end locale l_set_child_nodes = l_type_wf + l_set_child_nodes_defs + - assumes set_child_nodes_writes: - "writes (set_child_nodes_locs ptr) (set_child_nodes ptr children) h h'" - assumes set_child_nodes_pointers_preserved: - "w \ set_child_nodes_locs object_ptr \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" - assumes set_child_nodes_types_preserved: - "w \ set_child_nodes_locs object_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" + assumes set_child_nodes_writes: + "writes (set_child_nodes_locs ptr) (set_child_nodes ptr children) h h'" + assumes set_child_nodes_pointers_preserved: + "w \ set_child_nodes_locs object_ptr \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" + assumes set_child_nodes_types_preserved: + "w \ set_child_nodes_locs object_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" global_interpretation l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines set_child_nodes = l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_child_nodes and @@ -537,7 +537,7 @@ interpretation declare l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_child_nodes_is_l_set_child_nodes [instances]: +lemma set_child_nodes_is_l_set_child_nodes [instances]: "l_set_child_nodes type_wf set_child_nodes set_child_nodes_locs" apply(unfold_locales) using set_child_nodes_pointers_preserved set_child_nodes_typess_preserved set_child_nodes_writes @@ -557,69 +557,69 @@ lemma set_child_nodes_get_child_nodes: proof - have "h \ check_in_heap ptr \\<^sub>r ()" using assms set_child_nodes_impl[unfolded a_set_child_nodes_def] invoke_ptr_in_heap - by (metis (full_types) check_in_heap_ptr_in_heap is_OK_returns_heap_I is_OK_returns_result_E + by (metis (full_types) check_in_heap_ptr_in_heap is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust) then have ptr_in_h: "ptr |\| object_ptr_kinds h" by (simp add: check_in_heap_ptr_in_heap is_OK_returns_result_I) have "type_wf h'" apply(unfold type_wf_impl) - apply(rule subst[where P=id, OF type_wf_preserved[OF set_child_nodes_writes assms(3), + apply(rule subst[where P=id, OF type_wf_preserved[OF set_child_nodes_writes assms(3), unfolded all_args_def], simplified]) - by(auto simp add: all_args_def assms(2)[unfolded type_wf_impl] + by(auto simp add: all_args_def assms(2)[unfolded type_wf_impl] set_child_nodes_locs_impl[unfolded a_set_child_nodes_locs_def] split: if_splits) have "h' \ check_in_heap ptr \\<^sub>r ()" - using check_in_heap_reads set_child_nodes_writes assms(3) \h \ check_in_heap ptr \\<^sub>r ()\ + using check_in_heap_reads set_child_nodes_writes assms(3) \h \ check_in_heap ptr \\<^sub>r ()\ apply(rule reads_writes_separate_forwards) by(auto simp add: all_args_def set_child_nodes_locs_impl[unfolded a_set_child_nodes_locs_def]) then have "ptr |\| object_ptr_kinds h'" using check_in_heap_ptr_in_heap by blast with assms ptr_in_h \type_wf h'\ show ?thesis - apply(auto simp add: get_child_nodes_impl set_child_nodes_impl type_wf_impl known_ptr_impl - a_get_child_nodes_def a_get_child_nodes_tups_def a_set_child_nodes_def - a_set_child_nodes_tups_def - del: bind_pure_returns_result_I2 + apply(auto simp add: get_child_nodes_impl set_child_nodes_impl type_wf_impl known_ptr_impl + a_get_child_nodes_def a_get_child_nodes_tups_def a_set_child_nodes_def + a_set_child_nodes_tups_def + del: bind_pure_returns_result_I2 intro!: bind_pure_returns_result_I2)[1] apply(split invoke_splits, rule conjI) apply(split invoke_splits, rule conjI) apply(split invoke_splits, rule conjI) - apply(auto simp add: NodeClass.known_ptr_defs - dest!: known_ptr_not_document_ptr known_ptr_not_character_data_ptr - known_ptr_not_element_ptr)[1] - apply(auto simp add: NodeClass.known_ptr_defs - dest!: known_ptr_not_document_ptr known_ptr_not_character_data_ptr - known_ptr_not_element_ptr)[1] + apply(auto simp add: NodeClass.known_ptr_defs + dest!: known_ptr_not_document_ptr known_ptr_not_character_data_ptr + known_ptr_not_element_ptr)[1] + apply(auto simp add: NodeClass.known_ptr_defs + dest!: known_ptr_not_document_ptr known_ptr_not_character_data_ptr + known_ptr_not_element_ptr)[1] apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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 get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok - split: list.splits option.splits - intro!: bind_pure_returns_result_I2 - dest: get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok; auto dest: returns_result_eq + split: list.splits option.splits + intro!: bind_pure_returns_result_I2 + dest: get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok; auto dest: returns_result_eq dest!: document_put_get[where getter = document_element])[1] (* slow, ca 1min *) apply(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 set_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)[1] by(auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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 dest: element_put_get) qed -lemma set_child_nodes_get_child_nodes_different_pointers: +lemma set_child_nodes_get_child_nodes_different_pointers: assumes "ptr \ ptr'" assumes "w \ set_child_nodes_locs ptr" - assumes "h \ w \\<^sub>h h'" + assumes "h \ w \\<^sub>h h'" assumes "r \ get_child_nodes_locs ptr'" shows "r h h'" using assms - apply(auto simp add: get_child_nodes_locs_impl set_child_nodes_locs_impl all_args_def - a_set_child_nodes_locs_def a_get_child_nodes_locs_def - split: if_splits option.splits )[1] - apply(rule is_document_ptr_kind_obtains) + apply(auto simp add: get_child_nodes_locs_impl set_child_nodes_locs_impl all_args_def + a_set_child_nodes_locs_def a_get_child_nodes_locs_def + split: if_splits option.splits )[1] + apply(rule is_document_ptr_kind_obtains) apply(simp) - apply(rule is_document_ptr_kind_obtains) + apply(rule is_document_ptr_kind_obtains) apply(auto)[1] apply(auto)[1] - apply(rule is_element_ptr_kind_obtains) + apply(rule is_element_ptr_kind_obtains) apply(auto)[1] apply(auto)[1] - apply(rule is_element_ptr_kind_obtains) - apply(auto)[1] + apply(rule is_element_ptr_kind_obtains) apply(auto)[1] + apply(auto)[1] done lemma set_child_nodes_element_ok [simp]: @@ -631,10 +631,12 @@ lemma set_child_nodes_element_ok [simp]: 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) + 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] + 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 @@ -648,10 +650,12 @@ lemma set_child_nodes_document1_ok [simp]: 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) + 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] + 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 @@ -666,7 +670,8 @@ lemma set_child_nodes_document2_ok [simp]: 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) + 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)[1] @@ -680,21 +685,21 @@ qed end locale l_set_child_nodes_get_child_nodes = l_get_child_nodes + l_set_child_nodes + - assumes set_child_nodes_get_child_nodes: - "type_wf h \ known_ptr ptr + assumes set_child_nodes_get_child_nodes: + "type_wf h \ known_ptr ptr \ h \ set_child_nodes ptr children \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children" - assumes set_child_nodes_get_child_nodes_different_pointers: - "ptr \ ptr' \ w \ set_child_nodes_locs ptr \ h \ w \\<^sub>h h' + assumes set_child_nodes_get_child_nodes_different_pointers: + "ptr \ ptr' \ w \ set_child_nodes_locs ptr \ h \ w \\<^sub>h h' \ r \ get_child_nodes_locs ptr' \ r h h'" interpretation - i_set_child_nodes_get_child_nodes?: l_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + i_set_child_nodes_get_child_nodes?: l_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs by unfold_locales declare l_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_child_nodes_get_child_nodes_is_l_set_child_nodes_get_child_nodes [instances]: - "l_set_child_nodes_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs +lemma set_child_nodes_get_child_nodes_is_l_set_child_nodes_get_child_nodes [instances]: + "l_set_child_nodes_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs" using get_child_nodes_is_l_get_child_nodes set_child_nodes_is_l_set_child_nodes apply(auto simp add: l_set_child_nodes_get_child_nodes_def l_set_child_nodes_get_child_nodes_axioms_def)[1] @@ -726,8 +731,8 @@ locale l_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\< l_get_attribute_defs get_attribute get_attribute_locs + l_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and get_attribute :: "(_) element_ptr \ attr_key \ (_, attr_value option) dom_prog" - and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + + and get_attribute :: "(_) element_ptr \ attr_key \ (_, attr_value option) dom_prog" + and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes get_attribute_impl: "get_attribute = a_get_attribute" assumes get_attribute_locs_impl: "get_attribute_locs = a_get_attribute_locs" @@ -735,33 +740,33 @@ begin lemma get_attribute_pure [simp]: "pure (get_attribute ptr k) h" by (auto simp add: bind_pure_I get_attribute_impl[unfolded a_get_attribute_def]) -lemma get_attribute_ok: +lemma get_attribute_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (get_attribute element_ptr k)" apply(unfold type_wf_impl) unfolding get_attribute_impl[unfolded a_get_attribute_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok by (metis bind_is_OK_pure_I return_ok ElementMonad.get_M_pure) - -lemma get_attribute_ptr_in_heap: + +lemma get_attribute_ptr_in_heap: "h \ ok (get_attribute element_ptr k) \ element_ptr |\| element_ptr_kinds h" unfolding get_attribute_impl[unfolded a_get_attribute_def] by (meson DocumentMonad.get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap bind_is_OK_E is_OK_returns_result_I) -lemma get_attribute_reads: +lemma get_attribute_reads: "reads (get_attribute_locs element_ptr) (get_attribute element_ptr k) h h'" - by(auto simp add: get_attribute_impl[unfolded a_get_attribute_def] - get_attribute_locs_impl[unfolded a_get_attribute_locs_def] - reads_insert_writes_set_right - intro!: reads_bind_pure) + by(auto simp add: get_attribute_impl[unfolded a_get_attribute_def] + get_attribute_locs_impl[unfolded a_get_attribute_locs_def] + reads_insert_writes_set_right + intro!: reads_bind_pure) end locale l_get_attribute = l_type_wf + l_get_attribute_defs + -assumes get_attribute_reads: - "reads (get_attribute_locs element_ptr) (get_attribute element_ptr k) h h'" -assumes get_attribute_ok: - "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (get_attribute element_ptr k)" -assumes get_attribute_ptr_in_heap: - "h \ ok (get_attribute element_ptr k) \ element_ptr |\| element_ptr_kinds h" -assumes get_attribute_pure [simp]: "pure (get_attribute element_ptr k) h" + assumes get_attribute_reads: + "reads (get_attribute_locs element_ptr) (get_attribute element_ptr k) h h'" + assumes get_attribute_ok: + "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (get_attribute element_ptr k)" + assumes get_attribute_ptr_in_heap: + "h \ ok (get_attribute element_ptr k) \ element_ptr |\| element_ptr_kinds h" + assumes get_attribute_pure [simp]: "pure (get_attribute element_ptr k) h" global_interpretation l_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines get_attribute = l_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_attribute and @@ -773,7 +778,7 @@ interpretation by (auto simp add: get_attribute_def get_attribute_locs_def) declare l_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_attribute_is_l_get_attribute [instances]: +lemma get_attribute_is_l_get_attribute [instances]: "l_get_attribute type_wf get_attribute get_attribute_locs" apply(unfold_locales) using get_attribute_reads get_attribute_ok get_attribute_ptr_in_heap get_attribute_pure @@ -785,7 +790,7 @@ subsubsection \set\_attribute\ locale l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs begin -definition +definition a_set_attribute :: "(_) element_ptr \ attr_key \ attr_value option \ (_, unit) dom_prog" where "a_set_attribute ptr k v = do { @@ -807,8 +812,8 @@ locale l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\< l_set_attribute_defs set_attribute set_attribute_locs + l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and set_attribute :: "(_) element_ptr \ attr_key \ attr_value option \ (_, unit) dom_prog" - and set_attribute_locs :: "(_) element_ptr \ (_, unit) dom_prog set" + + and set_attribute :: "(_) element_ptr \ attr_key \ attr_value option \ (_, unit) dom_prog" + and set_attribute_locs :: "(_) element_ptr \ (_, unit) dom_prog set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes set_attribute_impl: "set_attribute = a_set_attribute" assumes set_attribute_locs_impl: "set_attribute_locs = a_set_attribute_locs" @@ -819,32 +824,32 @@ lemmas set_attribute_locs_def = set_attribute_locs_impl[unfolded a_set_attribute lemma set_attribute_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (set_attribute element_ptr k v)" apply(unfold type_wf_impl) unfolding set_attribute_impl[unfolded a_set_attribute_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok - by(metis (no_types, lifting) DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ElementMonad.get_M_pure bind_is_OK_E - bind_is_OK_pure_I is_OK_returns_result_I) + by(metis (no_types, lifting) DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ElementMonad.get_M_pure bind_is_OK_E + bind_is_OK_pure_I is_OK_returns_result_I) -lemma set_attribute_writes: +lemma set_attribute_writes: "writes (set_attribute_locs element_ptr) (set_attribute element_ptr k v) h h'" - by(auto simp add: set_attribute_impl[unfolded a_set_attribute_def] - set_attribute_locs_impl[unfolded a_set_attribute_locs_def] - intro: writes_bind_pure) + by(auto simp add: set_attribute_impl[unfolded a_set_attribute_def] + set_attribute_locs_impl[unfolded a_set_attribute_locs_def] + intro: writes_bind_pure) end locale l_set_attribute = l_type_wf + l_set_attribute_defs + - assumes set_attribute_writes: + assumes set_attribute_writes: "writes (set_attribute_locs element_ptr) (set_attribute element_ptr k v) h h'" - assumes set_attribute_ok: + assumes set_attribute_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (set_attribute element_ptr k v)" global_interpretation l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines set_attribute = l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_attribute and set_attribute_locs = l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_attribute_locs . -interpretation +interpretation i_set_attribute?: l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_attribute set_attribute_locs apply(unfold_locales) by (auto simp add: set_attribute_def set_attribute_locs_def) declare l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_attribute_is_l_set_attribute [instances]: +lemma set_attribute_is_l_set_attribute [instances]: "l_set_attribute type_wf set_attribute set_attribute_locs" apply(unfold_locales) using set_attribute_ok set_attribute_writes @@ -860,11 +865,11 @@ begin lemma set_attribute_get_attribute: "h \ set_attribute ptr k v \\<^sub>h h' \ h' \ get_attribute ptr k \\<^sub>r v" - by(auto simp add: set_attribute_impl[unfolded a_set_attribute_def] - get_attribute_impl[unfolded a_get_attribute_def] - elim!: bind_returns_heap_E2 - intro!: bind_pure_returns_result_I - elim: element_put_get) + by(auto simp add: set_attribute_impl[unfolded a_set_attribute_def] + get_attribute_impl[unfolded a_get_attribute_def] + elim!: bind_returns_heap_E2 + intro!: bind_pure_returns_result_I + elim: element_put_get) end locale l_set_attribute_get_attribute = l_get_attribute + l_set_attribute + @@ -872,12 +877,12 @@ locale l_set_attribute_get_attribute = l_get_attribute + l_set_attribute + "h \ set_attribute ptr k v \\<^sub>h h' \ h' \ get_attribute ptr k \\<^sub>r v" interpretation - i_set_attribute_get_attribute?: l_set_attribute_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - get_attribute get_attribute_locs set_attribute set_attribute_locs + i_set_attribute_get_attribute?: l_set_attribute_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + get_attribute get_attribute_locs set_attribute set_attribute_locs by(unfold_locales) declare l_set_attribute_get_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_attribute_get_attribute_is_l_set_attribute_get_attribute [instances]: +lemma set_attribute_get_attribute_is_l_set_attribute_get_attribute [instances]: "l_set_attribute_get_attribute type_wf get_attribute get_attribute_locs set_attribute set_attribute_locs" using get_attribute_is_l_get_attribute set_attribute_is_l_set_attribute apply(simp add: l_set_attribute_get_attribute_def l_set_attribute_get_attribute_axioms_def) @@ -892,24 +897,24 @@ locale l_set_attribute_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\< begin lemma set_attribute_get_child_nodes: "\w \ set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" - by(auto simp add: set_attribute_locs_def get_child_nodes_locs_def all_args_def - intro: element_put_get_preserved[where setter=attrs_update]) + by(auto simp add: set_attribute_locs_def get_child_nodes_locs_def all_args_def + intro: element_put_get_preserved[where setter=attrs_update]) end locale l_set_attribute_get_child_nodes = l_set_attribute + l_get_child_nodes + - assumes set_attribute_get_child_nodes: - "\w \ set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" + assumes set_attribute_get_child_nodes: + "\w \ set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" interpretation - i_set_attribute_get_child_nodes?: l_set_attribute_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - set_attribute set_attribute_locs known_ptr get_child_nodes get_child_nodes_locs + i_set_attribute_get_child_nodes?: l_set_attribute_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + set_attribute set_attribute_locs known_ptr get_child_nodes get_child_nodes_locs by unfold_locales declare l_set_attribute_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma set_attribute_get_child_nodes_is_l_set_attribute_get_child_nodes [instances]: - "l_set_attribute_get_child_nodes type_wf set_attribute set_attribute_locs known_ptr + "l_set_attribute_get_child_nodes type_wf set_attribute set_attribute_locs known_ptr get_child_nodes get_child_nodes_locs" using set_attribute_is_l_set_attribute get_child_nodes_is_l_get_child_nodes apply(simp add: l_set_attribute_get_child_nodes_def l_set_attribute_get_child_nodes_axioms_def) @@ -932,7 +937,7 @@ definition a_get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) "a_get_disconnected_nodes_locs document_ptr = {preserved (get_M document_ptr disconnected_nodes)}" end -locale l_get_disconnected_nodes_defs = +locale l_get_disconnected_nodes_defs = fixes get_disconnected_nodes :: "(_) document_ptr \ (_, (_) node_ptr list) dom_prog" fixes get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" @@ -941,24 +946,24 @@ locale l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\ l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes get_disconnected_nodes_impl: "get_disconnected_nodes = a_get_disconnected_nodes" assumes get_disconnected_nodes_locs_impl: "get_disconnected_nodes_locs = a_get_disconnected_nodes_locs" begin -lemmas +lemmas get_disconnected_nodes_def = get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] -lemmas +lemmas get_disconnected_nodes_locs_def = get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] -lemma get_disconnected_nodes_ok: +lemma get_disconnected_nodes_ok: "type_wf h \ document_ptr |\| document_ptr_kinds h \ h \ ok (get_disconnected_nodes document_ptr)" apply(unfold type_wf_impl) unfolding get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] using get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok by fast -lemma get_disconnected_nodes_ptr_in_heap: +lemma get_disconnected_nodes_ptr_in_heap: "h \ ok (get_disconnected_nodes document_ptr) \ document_ptr |\| document_ptr_kinds h" unfolding get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] by (simp add: DocumentMonad.get_M_ptr_in_heap) @@ -966,38 +971,38 @@ lemma get_disconnected_nodes_ptr_in_heap: lemma get_disconnected_nodes_pure [simp]: "pure (get_disconnected_nodes document_ptr) h" unfolding get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] by simp -lemma get_disconnected_nodes_reads: +lemma get_disconnected_nodes_reads: "reads (get_disconnected_nodes_locs document_ptr) (get_disconnected_nodes document_ptr) h h'" - by(simp add: get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] - get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] - reads_bind_pure reads_insert_writes_set_right) + by(simp add: get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def] + get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] + reads_bind_pure reads_insert_writes_set_right) end locale l_get_disconnected_nodes = l_type_wf + l_get_disconnected_nodes_defs + - assumes get_disconnected_nodes_reads: + assumes get_disconnected_nodes_reads: "reads (get_disconnected_nodes_locs document_ptr) (get_disconnected_nodes document_ptr) h h'" - assumes get_disconnected_nodes_ok: + assumes get_disconnected_nodes_ok: "type_wf h \ document_ptr |\| document_ptr_kinds h \ h \ ok (get_disconnected_nodes document_ptr)" - assumes get_disconnected_nodes_ptr_in_heap: + assumes get_disconnected_nodes_ptr_in_heap: "h \ ok (get_disconnected_nodes document_ptr) \ document_ptr |\| document_ptr_kinds h" - assumes get_disconnected_nodes_pure [simp]: - "pure (get_disconnected_nodes document_ptr) h" + assumes get_disconnected_nodes_pure [simp]: + "pure (get_disconnected_nodes document_ptr) h" global_interpretation l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines get_disconnected_nodes = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_disconnected_nodes and get_disconnected_nodes_locs = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_disconnected_nodes_locs . -interpretation - i_get_disconnected_nodes?: l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes - get_disconnected_nodes_locs +interpretation + i_get_disconnected_nodes?: l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes + get_disconnected_nodes_locs apply(unfold_locales) by (auto simp add: get_disconnected_nodes_def get_disconnected_nodes_locs_def) declare l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_disconnected_nodes_is_l_get_disconnected_nodes [instances]: +lemma get_disconnected_nodes_is_l_get_disconnected_nodes [instances]: "l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs" apply(simp add: l_get_disconnected_nodes_def) - using get_disconnected_nodes_reads get_disconnected_nodes_ok get_disconnected_nodes_ptr_in_heap - get_disconnected_nodes_pure + using get_disconnected_nodes_reads get_disconnected_nodes_ok get_disconnected_nodes_ptr_in_heap + get_disconnected_nodes_pure by blast+ @@ -1007,28 +1012,28 @@ locale l_set_child_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\ l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + CD: l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_child_nodes_get_disconnected_nodes: +lemma set_child_nodes_get_disconnected_nodes: "\w \ a_set_child_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ a_get_disconnected_nodes_locs ptr'. r h h'))" by(auto simp add: a_set_child_nodes_locs_def a_get_disconnected_nodes_locs_def all_args_def) end locale l_set_child_nodes_get_disconnected_nodes = l_set_child_nodes + l_get_disconnected_nodes + - assumes set_child_nodes_get_disconnected_nodes: - "\w \ set_child_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" + assumes set_child_nodes_get_disconnected_nodes: + "\w \ set_child_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" interpretation - i_set_child_nodes_get_disconnected_nodes?: l_set_child_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - known_ptr set_child_nodes set_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + i_set_child_nodes_get_disconnected_nodes?: l_set_child_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + known_ptr set_child_nodes set_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs by(unfold_locales) declare l_set_child_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma set_child_nodes_get_disconnected_nodes_is_l_set_child_nodes_get_disconnected_nodes [instances]: - "l_set_child_nodes_get_disconnected_nodes type_wf set_child_nodes set_child_nodes_locs + "l_set_child_nodes_get_disconnected_nodes type_wf set_child_nodes set_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs" using set_child_nodes_is_l_set_child_nodes get_disconnected_nodes_is_l_get_disconnected_nodes - apply(simp add: l_set_child_nodes_get_disconnected_nodes_def - l_set_child_nodes_get_disconnected_nodes_axioms_def) + apply(simp add: l_set_child_nodes_get_disconnected_nodes_def + l_set_child_nodes_get_disconnected_nodes_axioms_def) using set_child_nodes_get_disconnected_nodes by fast @@ -1039,27 +1044,27 @@ locale l_set_attribute_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^ l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_attribute_get_disconnected_nodes: +lemma set_attribute_get_disconnected_nodes: "\w \ a_set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ a_get_disconnected_nodes_locs ptr'. r h h'))" by(auto simp add: a_set_attribute_locs_def a_get_disconnected_nodes_locs_def all_args_def) end locale l_set_attribute_get_disconnected_nodes = l_set_attribute + l_get_disconnected_nodes + - assumes set_attribute_get_disconnected_nodes: - "\w \ set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" + assumes set_attribute_get_disconnected_nodes: + "\w \ set_attribute_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" interpretation - i_set_attribute_get_disconnected_nodes?: l_set_attribute_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - set_attribute set_attribute_locs get_disconnected_nodes get_disconnected_nodes_locs + i_set_attribute_get_disconnected_nodes?: l_set_attribute_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + set_attribute set_attribute_locs get_disconnected_nodes get_disconnected_nodes_locs by(unfold_locales) declare l_set_attribute_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma set_attribute_get_disconnected_nodes_is_l_set_attribute_get_disconnected_nodes [instances]: - "l_set_attribute_get_disconnected_nodes type_wf set_attribute set_attribute_locs + "l_set_attribute_get_disconnected_nodes type_wf set_attribute set_attribute_locs get_disconnected_nodes get_disconnected_nodes_locs" using set_attribute_is_l_set_attribute get_disconnected_nodes_is_l_get_disconnected_nodes - apply(simp add: l_set_attribute_get_disconnected_nodes_def - l_set_attribute_get_disconnected_nodes_axioms_def) + apply(simp add: l_set_attribute_get_disconnected_nodes_def + l_set_attribute_get_disconnected_nodes_axioms_def) using set_attribute_get_disconnected_nodes by fast @@ -1069,22 +1074,22 @@ paragraph \new\_element\ locale l_new_element_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes get_disconnected_nodes_locs for type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_disconnected_nodes_new_element: - "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' +lemma get_disconnected_nodes_new_element: + "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" by(auto simp add: get_disconnected_nodes_locs_def new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t) end locale l_new_element_get_disconnected_nodes = l_get_disconnected_nodes_defs + - assumes get_disconnected_nodes_new_element: - "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' + assumes get_disconnected_nodes_new_element: + "h \ new_element \\<^sub>r new_element_ptr \ h \ new_element \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" -interpretation i_new_element_get_disconnected_nodes?: - l_new_element_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes +interpretation i_new_element_get_disconnected_nodes?: + l_new_element_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes get_disconnected_nodes_locs by unfold_locales declare l_new_element_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1099,23 +1104,23 @@ paragraph \new\_character\_data\ locale l_new_character_data_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes get_disconnected_nodes_locs for type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_disconnected_nodes_new_character_data: +lemma get_disconnected_nodes_new_character_data: "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" by(auto simp add: get_disconnected_nodes_locs_def new_character_data_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t) end locale l_new_character_data_get_disconnected_nodes = l_get_disconnected_nodes_defs + - assumes get_disconnected_nodes_new_character_data: - "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' + assumes get_disconnected_nodes_new_character_data: + "h \ new_character_data \\<^sub>r new_character_data_ptr \ h \ new_character_data \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" -interpretation i_new_character_data_get_disconnected_nodes?: - l_new_character_data_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes - get_disconnected_nodes_locs +interpretation i_new_character_data_get_disconnected_nodes?: + l_new_character_data_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes + get_disconnected_nodes_locs by unfold_locales declare l_new_character_data_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1129,32 +1134,32 @@ paragraph \new\_document\ locale l_new_document_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes get_disconnected_nodes_locs for type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin -lemma get_disconnected_nodes_new_document_different_pointers: +lemma get_disconnected_nodes_new_document_different_pointers: "new_document_ptr \ ptr' \ h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" by(auto simp add: get_disconnected_nodes_locs_def new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t) lemma new_document_no_disconnected_nodes: - "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' + "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" by(simp add: get_disconnected_nodes_def new_document_disconnected_nodes) - + end -interpretation i_new_document_get_disconnected_nodes?: +interpretation i_new_document_get_disconnected_nodes?: l_new_document_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes get_disconnected_nodes_locs by unfold_locales declare l_new_document_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] locale l_new_document_get_disconnected_nodes = l_get_disconnected_nodes_defs + - assumes get_disconnected_nodes_new_document_different_pointers: - "new_document_ptr \ ptr' \ h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' + assumes get_disconnected_nodes_new_document_different_pointers: + "new_document_ptr \ ptr' \ h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" assumes new_document_no_disconnected_nodes: - "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' + "h \ new_document \\<^sub>r new_document_ptr \ h \ new_document \\<^sub>h h' \ h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" lemma new_document_get_disconnected_nodes_is_l_new_document_get_disconnected_nodes [instances]: @@ -1173,7 +1178,8 @@ begin definition a_set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ (_, unit) dom_prog" where - "a_set_disconnected_nodes document_ptr disc_nodes = put_M document_ptr disconnected_nodes_update disc_nodes" + "a_set_disconnected_nodes document_ptr disc_nodes = +put_M document_ptr disconnected_nodes_update disc_nodes" lemmas set_disconnected_nodes_defs = a_set_disconnected_nodes_def definition a_set_disconnected_nodes_locs :: "(_) document_ptr \ (_, unit) dom_prog set" @@ -1186,41 +1192,44 @@ locale l_set_disconnected_nodes_defs = fixes set_disconnected_nodes_locs :: "(_) document_ptr \ (_, unit) dom_prog set" locale l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_type_wf type_wf + + l_type_wf type_wf + l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs + l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ (_, unit) dom_prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ (_, unit) dom_prog set" + + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ (_, unit) dom_prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ (_, unit) dom_prog set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes set_disconnected_nodes_impl: "set_disconnected_nodes = a_set_disconnected_nodes" assumes set_disconnected_nodes_locs_impl: "set_disconnected_nodes_locs = a_set_disconnected_nodes_locs" begin lemmas set_disconnected_nodes_def = set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] -lemmas set_disconnected_nodes_locs_def = set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] +lemmas set_disconnected_nodes_locs_def = + set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] lemma set_disconnected_nodes_ok: - "type_wf h \ document_ptr |\| document_ptr_kinds h \ h \ ok (set_disconnected_nodes document_ptr node_ptrs)" - by (simp add: type_wf_impl put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def]) + "type_wf h \ document_ptr |\| document_ptr_kinds h \ +h \ ok (set_disconnected_nodes document_ptr node_ptrs)" + by (simp add: type_wf_impl put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok + set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def]) -lemma set_disconnected_nodes_ptr_in_heap: +lemma set_disconnected_nodes_ptr_in_heap: "h \ ok (set_disconnected_nodes document_ptr disc_nodes) \ document_ptr |\| document_ptr_kinds h" - by (simp add: set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] - DocumentMonad.put_M_ptr_in_heap) + by (simp add: set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] + DocumentMonad.put_M_ptr_in_heap) -lemma set_disconnected_nodes_writes: +lemma set_disconnected_nodes_writes: "writes (set_disconnected_nodes_locs document_ptr) (set_disconnected_nodes document_ptr disc_nodes) h h'" - by(auto simp add: set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] - set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] - intro: writes_bind_pure) + by(auto simp add: set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] + set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] + intro: writes_bind_pure) lemma set_disconnected_nodes_pointers_preserved: assumes "w \ set_disconnected_nodes_locs object_ptr" assumes "h \ w \\<^sub>h h'" shows "object_ptr_kinds h = object_ptr_kinds h'" using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)] - by(auto simp add: all_args_def set_disconnected_nodes_locs_impl[unfolded - a_set_disconnected_nodes_locs_def] - split: if_splits) + by(auto simp add: all_args_def set_disconnected_nodes_locs_impl[unfolded + a_set_disconnected_nodes_locs_def] + split: if_splits) lemma set_disconnected_nodes_typess_preserved: assumes "w \ set_disconnected_nodes_locs object_ptr" @@ -1228,86 +1237,92 @@ lemma set_disconnected_nodes_typess_preserved: shows "type_wf h = type_wf h'" using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)] apply(unfold type_wf_impl) - by(auto simp add: all_args_def - set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] - split: if_splits) + by(auto simp add: all_args_def + set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] + split: if_splits) end locale l_set_disconnected_nodes = l_type_wf + l_set_disconnected_nodes_defs + - assumes set_disconnected_nodes_writes: - "writes (set_disconnected_nodes_locs document_ptr) (set_disconnected_nodes document_ptr disc_nodes) h h'" - assumes set_disconnected_nodes_ok: - "type_wf h \ document_ptr |\| document_ptr_kinds h \ h \ ok (set_disconnected_nodes document_ptr disc_noded)" - assumes set_disconnected_nodes_ptr_in_heap: - "h \ ok (set_disconnected_nodes document_ptr disc_noded) \ document_ptr |\| document_ptr_kinds h" - assumes set_disconnected_nodes_pointers_preserved: - "w \ set_disconnected_nodes_locs document_ptr \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" - assumes set_disconnected_nodes_types_preserved: - "w \ set_disconnected_nodes_locs document_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" + assumes set_disconnected_nodes_writes: + "writes (set_disconnected_nodes_locs document_ptr) +(set_disconnected_nodes document_ptr disc_nodes) h h'" + assumes set_disconnected_nodes_ok: + "type_wf h \ document_ptr |\| document_ptr_kinds h \ +h \ ok (set_disconnected_nodes document_ptr disc_noded)" + assumes set_disconnected_nodes_ptr_in_heap: + "h \ ok (set_disconnected_nodes document_ptr disc_noded) \ +document_ptr |\| document_ptr_kinds h" + assumes set_disconnected_nodes_pointers_preserved: + "w \ set_disconnected_nodes_locs document_ptr \ h \ w \\<^sub>h h' \ +object_ptr_kinds h = object_ptr_kinds h'" + assumes set_disconnected_nodes_types_preserved: + "w \ set_disconnected_nodes_locs document_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" global_interpretation l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines set_disconnected_nodes = l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_disconnected_nodes and set_disconnected_nodes_locs = l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_disconnected_nodes_locs . -interpretation - i_set_disconnected_nodes?: l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_disconnected_nodes - set_disconnected_nodes_locs +interpretation + i_set_disconnected_nodes?: l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_disconnected_nodes + set_disconnected_nodes_locs apply unfold_locales by (auto simp add: set_disconnected_nodes_def set_disconnected_nodes_locs_def) declare l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_disconnected_nodes_is_l_set_disconnected_nodes [instances]: +lemma set_disconnected_nodes_is_l_set_disconnected_nodes [instances]: "l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs" apply(simp add: l_set_disconnected_nodes_def) - using set_disconnected_nodes_ok set_disconnected_nodes_writes set_disconnected_nodes_pointers_preserved - set_disconnected_nodes_ptr_in_heap set_disconnected_nodes_typess_preserved + using set_disconnected_nodes_ok set_disconnected_nodes_writes + set_disconnected_nodes_pointers_preserved + set_disconnected_nodes_ptr_in_heap set_disconnected_nodes_typess_preserved by blast+ paragraph \get\_disconnected\_nodes\ -locale l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - + l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +locale l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin lemma set_disconnected_nodes_get_disconnected_nodes: assumes "h \ a_set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h'" shows "h' \ a_get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" - using assms + using assms by(auto simp add: a_get_disconnected_nodes_def a_set_disconnected_nodes_def) -lemma set_disconnected_nodes_get_disconnected_nodes_different_pointers: +lemma set_disconnected_nodes_get_disconnected_nodes_different_pointers: assumes "ptr \ ptr'" assumes "w \ a_set_disconnected_nodes_locs ptr" - assumes "h \ w \\<^sub>h h'" + assumes "h \ w \\<^sub>h h'" assumes "r \ a_get_disconnected_nodes_locs ptr'" shows "r h h'" using assms - by(auto simp add: all_args_def a_set_disconnected_nodes_locs_def a_get_disconnected_nodes_locs_def - split: if_splits option.splits ) + by(auto simp add: all_args_def a_set_disconnected_nodes_locs_def a_get_disconnected_nodes_locs_def + split: if_splits option.splits ) end -locale l_set_disconnected_nodes_get_disconnected_nodes = l_get_disconnected_nodes - + l_set_disconnected_nodes + - assumes set_disconnected_nodes_get_disconnected_nodes: - "h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' +locale l_set_disconnected_nodes_get_disconnected_nodes = l_get_disconnected_nodes + + l_set_disconnected_nodes + + assumes set_disconnected_nodes_get_disconnected_nodes: + "h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' \ h' \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" - assumes set_disconnected_nodes_get_disconnected_nodes_different_pointers: - "ptr \ ptr' \ w \ set_disconnected_nodes_locs ptr \ h \ w \\<^sub>h h' + assumes set_disconnected_nodes_get_disconnected_nodes_different_pointers: + "ptr \ ptr' \ w \ set_disconnected_nodes_locs ptr \ h \ w \\<^sub>h h' \ r \ get_disconnected_nodes_locs ptr' \ r h h'" interpretation i_set_disconnected_nodes_get_disconnected_nodes?: - l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs by unfold_locales declare l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma set_disconnected_nodes_get_disconnected_nodes_is_l_set_disconnected_nodes_get_disconnected_nodes [instances]: - "l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +lemma set_disconnected_nodes_get_disconnected_nodes_is_l_set_disconnected_nodes_get_disconnected_nodes + [instances]: + "l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs" using set_disconnected_nodes_is_l_set_disconnected_nodes get_disconnected_nodes_is_l_get_disconnected_nodes - apply(simp add: l_set_disconnected_nodes_get_disconnected_nodes_def - l_set_disconnected_nodes_get_disconnected_nodes_axioms_def) - using set_disconnected_nodes_get_disconnected_nodes - set_disconnected_nodes_get_disconnected_nodes_different_pointers + apply(simp add: l_set_disconnected_nodes_get_disconnected_nodes_def + l_set_disconnected_nodes_get_disconnected_nodes_axioms_def) + using set_disconnected_nodes_get_disconnected_nodes + set_disconnected_nodes_get_disconnected_nodes_different_pointers by fast+ @@ -1317,21 +1332,21 @@ locale l_set_disconnected_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\ l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_disconnected_nodes_get_child_nodes: +lemma set_disconnected_nodes_get_child_nodes: "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" - by(auto simp add: set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] - get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def) + by(auto simp add: set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] + get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def) end locale l_set_disconnected_nodes_get_child_nodes = l_set_disconnected_nodes_defs + l_get_child_nodes_defs + - assumes set_disconnected_nodes_get_child_nodes [simp]: + assumes set_disconnected_nodes_get_child_nodes [simp]: "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" interpretation - i_set_disconnected_nodes_get_child_nodes?: l_set_disconnected_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf - set_disconnected_nodes set_disconnected_nodes_locs - known_ptr get_child_nodes get_child_nodes_locs + i_set_disconnected_nodes_get_child_nodes?: l_set_disconnected_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + type_wf + set_disconnected_nodes set_disconnected_nodes_locs + known_ptr get_child_nodes get_child_nodes_locs by unfold_locales declare l_set_disconnected_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1363,10 +1378,10 @@ locale l_get_tag_name_defs = locale l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_type_wf type_wf + l_get_tag_name_defs get_tag_name get_tag_name_locs + - l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and get_tag_name :: "(_) element_ptr \ (_, tag_name) dom_prog" - and get_tag_name_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + + and get_tag_name :: "(_) element_ptr \ (_, tag_name) dom_prog" + and get_tag_name_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes get_tag_name_impl: "get_tag_name = a_get_tag_name" assumes get_tag_name_locs_impl: "get_tag_name_locs = a_get_tag_name_locs" @@ -1376,7 +1391,7 @@ lemmas get_tag_name_locs_def = get_tag_name_locs_impl[unfolded a_get_tag_name_lo -lemma get_tag_name_ok: +lemma get_tag_name_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (get_tag_name element_ptr)" apply(unfold type_wf_impl get_tag_name_impl[unfolded a_get_tag_name_def]) using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok @@ -1390,23 +1405,23 @@ lemma get_tag_name_ptr_in_heap [simp]: assumes "h \ get_tag_name element_ptr \\<^sub>r children" shows "element_ptr |\| element_ptr_kinds h" using assms - by(auto simp add: get_tag_name_impl[unfolded a_get_tag_name_def] get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap - dest: is_OK_returns_result_I) + by(auto simp add: get_tag_name_impl[unfolded a_get_tag_name_def] get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap + dest: is_OK_returns_result_I) lemma get_tag_name_reads: "reads (get_tag_name_locs element_ptr) (get_tag_name element_ptr) h h'" - by(simp add: get_tag_name_impl[unfolded a_get_tag_name_def] - get_tag_name_locs_impl[unfolded a_get_tag_name_locs_def] reads_bind_pure - reads_insert_writes_set_right) + by(simp add: get_tag_name_impl[unfolded a_get_tag_name_def] + get_tag_name_locs_impl[unfolded a_get_tag_name_locs_def] reads_bind_pure + reads_insert_writes_set_right) end locale l_get_tag_name = l_type_wf + l_get_tag_name_defs + - assumes get_tag_name_reads: + assumes get_tag_name_reads: "reads (get_tag_name_locs element_ptr) (get_tag_name element_ptr) h h'" - assumes get_tag_name_ok: + assumes get_tag_name_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (get_tag_name element_ptr)" - assumes get_tag_name_ptr_in_heap: + assumes get_tag_name_ptr_in_heap: "h \ ok (get_tag_name element_ptr) \ element_ptr |\| element_ptr_kinds h" - assumes get_tag_name_pure [simp]: + assumes get_tag_name_pure [simp]: "pure (get_tag_name element_ptr) h" @@ -1420,7 +1435,7 @@ interpretation by (auto simp add: get_tag_name_def get_tag_name_locs_def) declare l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_tag_name_is_l_get_tag_name [instances]: +lemma get_tag_name_is_l_get_tag_name [instances]: "l_get_tag_name type_wf get_tag_name get_tag_name_locs" apply(unfold_locales) using get_tag_name_reads get_tag_name_ok get_tag_name_ptr_in_heap get_tag_name_pure @@ -1433,24 +1448,24 @@ locale l_set_disconnected_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^s l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_disconnected_nodes_get_tag_name: +lemma set_disconnected_nodes_get_tag_name: "\w \ a_set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ a_get_tag_name_locs ptr'. r h h'))" by(auto simp add: a_set_disconnected_nodes_locs_def a_get_tag_name_locs_def all_args_def) end locale l_set_disconnected_nodes_get_tag_name = l_set_disconnected_nodes + l_get_tag_name + - assumes set_disconnected_nodes_get_tag_name: - "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_tag_name_locs ptr'. r h h'))" + assumes set_disconnected_nodes_get_tag_name: + "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_tag_name_locs ptr'. r h h'))" interpretation - i_set_disconnected_nodes_get_tag_name?: l_set_disconnected_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - set_disconnected_nodes set_disconnected_nodes_locs - get_tag_name get_tag_name_locs + i_set_disconnected_nodes_get_tag_name?: l_set_disconnected_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf + set_disconnected_nodes set_disconnected_nodes_locs + get_tag_name get_tag_name_locs by unfold_locales declare l_set_disconnected_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma set_disconnected_nodes_get_tag_name_is_l_set_disconnected_nodes_get_tag_name [instances]: - "l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs + "l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs get_tag_name get_tag_name_locs" using set_disconnected_nodes_is_l_set_disconnected_nodes get_tag_name_is_l_get_tag_name apply(simp add: l_set_disconnected_nodes_get_tag_name_def l_set_disconnected_nodes_get_tag_name_axioms_def) @@ -1464,19 +1479,19 @@ locale l_set_child_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^ l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_child_nodes_get_tag_name: +lemma set_child_nodes_get_tag_name: "\w \ set_child_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_tag_name_locs ptr'. r h h'))" - by(auto simp add: set_child_nodes_locs_def get_tag_name_locs_def all_args_def - intro: element_put_get_preserved[where getter=tag_name and setter=child_nodes_update]) + by(auto simp add: set_child_nodes_locs_def get_tag_name_locs_def all_args_def + intro: element_put_get_preserved[where getter=tag_name and setter=child_nodes_update]) end locale l_set_child_nodes_get_tag_name = l_set_child_nodes + l_get_tag_name + - assumes set_child_nodes_get_tag_name: + assumes set_child_nodes_get_tag_name: "\w \ set_child_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_tag_name_locs ptr'. r h h'))" interpretation - i_set_child_nodes_get_tag_name?: l_set_child_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr - set_child_nodes set_child_nodes_locs get_tag_name get_tag_name_locs + i_set_child_nodes_get_tag_name?: l_set_child_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr + set_child_nodes set_child_nodes_locs get_tag_name get_tag_name_locs by unfold_locales declare l_set_child_nodes_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1515,8 +1530,8 @@ locale l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^ l_set_tag_name_defs set_tag_name set_tag_name_locs + l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and set_tag_name :: "(_) element_ptr \ char list \ (_, unit) dom_prog" - and set_tag_name_locs :: "(_) element_ptr \ (_, unit) dom_prog set" + + and set_tag_name :: "(_) element_ptr \ char list \ (_, unit) dom_prog" + and set_tag_name_locs :: "(_) element_ptr \ (_, unit) dom_prog set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes set_tag_name_impl: "set_tag_name = a_set_tag_name" assumes set_tag_name_locs_impl: "set_tag_name_locs = a_set_tag_name_locs" @@ -1526,13 +1541,13 @@ lemma set_tag_name_ok: "type_wf h \ element_ptr |\| element_ptr_kinds h \ h \ ok (set_tag_name element_ptr tag)" apply(unfold type_wf_impl) unfolding set_tag_name_impl[unfolded a_set_tag_name_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok - by (metis (no_types, lifting) DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ElementMonad.get_M_pure bind_is_OK_E - bind_is_OK_pure_I is_OK_returns_result_I) + by (metis (no_types, lifting) DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ElementMonad.get_M_pure bind_is_OK_E + bind_is_OK_pure_I is_OK_returns_result_I) lemma set_tag_name_writes: "writes (set_tag_name_locs element_ptr) (set_tag_name element_ptr tag) h h'" by(auto simp add: set_tag_name_impl[unfolded a_set_tag_name_def] - set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] intro: writes_bind_pure) + set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] intro: writes_bind_pure) lemma set_tag_name_pointers_preserved: assumes "w \ set_tag_name_locs element_ptr" @@ -1540,7 +1555,7 @@ lemma set_tag_name_pointers_preserved: shows "object_ptr_kinds h = object_ptr_kinds h'" using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)] by(auto simp add: all_args_def set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] - split: if_splits) + split: if_splits) lemma set_tag_name_typess_preserved: assumes "w \ set_tag_name_locs element_ptr" @@ -1549,7 +1564,7 @@ lemma set_tag_name_typess_preserved: apply(unfold type_wf_impl) using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)] by(auto simp add: all_args_def set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] - split: if_splits) + split: if_splits) end locale l_set_tag_name = l_type_wf + l_set_tag_name_defs + @@ -1566,7 +1581,7 @@ locale l_set_tag_name = l_type_wf + l_set_tag_name_defs + global_interpretation l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines set_tag_name = l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_name and set_tag_name_locs = l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_name_locs . -interpretation +interpretation i_set_tag_name?: l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_tag_name set_tag_name_locs apply(unfold_locales) by (auto simp add: set_tag_name_def set_tag_name_locs_def) @@ -1576,7 +1591,7 @@ lemma set_tag_name_is_l_set_tag_name [instances]: "l_set_tag_name type_wf set_tag_name set_tag_name_locs" apply(simp add: l_set_tag_name_def) using set_tag_name_ok set_tag_name_writes set_tag_name_pointers_preserved - set_tag_name_typess_preserved + set_tag_name_typess_preserved by blast paragraph \get\_child\_nodes\ @@ -1588,8 +1603,8 @@ begin lemma set_tag_name_get_child_nodes: "\w \ set_tag_name_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" by(auto simp add: set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] - get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def - intro: element_put_get_preserved[where setter=tag_name_update and getter=child_nodes]) + get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def + intro: element_put_get_preserved[where setter=tag_name_update and getter=child_nodes]) end locale l_set_tag_name_get_child_nodes = l_set_tag_name + l_get_child_nodes + @@ -1598,8 +1613,8 @@ locale l_set_tag_name_get_child_nodes = l_set_tag_name + l_get_child_nodes + interpretation i_set_tag_name_get_child_nodes?: l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - set_tag_name set_tag_name_locs known_ptr - get_child_nodes get_child_nodes_locs + set_tag_name set_tag_name_locs known_ptr + get_child_nodes get_child_nodes_locs by unfold_locales declare l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1621,18 +1636,18 @@ begin lemma set_tag_name_get_disconnected_nodes: "\w \ set_tag_name_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" by(auto simp add: set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] - get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] - all_args_def) + get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] + all_args_def) end locale l_set_tag_name_get_disconnected_nodes = l_set_tag_name + l_get_disconnected_nodes + assumes set_tag_name_get_disconnected_nodes: - "\w \ set_tag_name_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" + "\w \ set_tag_name_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" interpretation i_set_tag_name_get_disconnected_nodes?: l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf - set_tag_name set_tag_name_locs get_disconnected_nodes - get_disconnected_nodes_locs + set_tag_name set_tag_name_locs get_disconnected_nodes + get_disconnected_nodes_locs by unfold_locales declare l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1641,7 +1656,7 @@ lemma set_tag_name_get_disconnected_nodes_is_l_set_tag_name_get_disconnected_nod get_disconnected_nodes_locs" using set_tag_name_is_l_set_tag_name get_disconnected_nodes_is_l_get_disconnected_nodes apply(simp add: l_set_tag_name_get_disconnected_nodes_def - l_set_tag_name_get_disconnected_nodes_axioms_def) + l_set_tag_name_get_disconnected_nodes_axioms_def) using set_tag_name_get_disconnected_nodes by fast @@ -1649,7 +1664,7 @@ lemma set_tag_name_get_disconnected_nodes_is_l_set_tag_name_get_disconnected_nod paragraph \get\_tag\_type\ locale l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - + l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin lemma set_tag_name_get_tag_name: assumes "h \ a_set_tag_name element_ptr tag \\<^sub>h h'" @@ -1665,20 +1680,20 @@ lemma set_tag_name_get_tag_name_different_pointers: shows "r h h'" using assms by(auto simp add: all_args_def a_set_tag_name_locs_def a_get_tag_name_locs_def - split: if_splits option.splits ) + split: if_splits option.splits ) end locale l_set_tag_name_get_tag_name = l_get_tag_name + l_set_tag_name + assumes set_tag_name_get_tag_name: - "h \ set_tag_name element_ptr tag \\<^sub>h h' + "h \ set_tag_name element_ptr tag \\<^sub>h h' \ h' \ get_tag_name element_ptr \\<^sub>r tag" assumes set_tag_name_get_tag_name_different_pointers: - "ptr \ ptr' \ w \ set_tag_name_locs ptr \ h \ w \\<^sub>h h' + "ptr \ ptr' \ w \ set_tag_name_locs ptr \ h \ w \\<^sub>h h' \ r \ get_tag_name_locs ptr' \ r h h'" interpretation i_set_tag_name_get_tag_name?: l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_tag_name - get_tag_name_locs set_tag_name set_tag_name_locs + get_tag_name_locs set_tag_name set_tag_name_locs by unfold_locales declare l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1687,9 +1702,9 @@ lemma set_tag_name_get_tag_name_is_l_set_tag_name_get_tag_name [instances]: set_tag_name set_tag_name_locs" using set_tag_name_is_l_set_tag_name get_tag_name_is_l_get_tag_name apply(simp add: l_set_tag_name_get_tag_name_def - l_set_tag_name_get_tag_name_axioms_def) + l_set_tag_name_get_tag_name_axioms_def) using set_tag_name_get_tag_name - set_tag_name_get_tag_name_different_pointers + set_tag_name_get_tag_name_different_pointers by fast+ @@ -1720,23 +1735,23 @@ locale l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M l_set_val_defs set_val set_val_locs + l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs for type_wf :: "(_) heap \ bool" - and set_val :: "(_) character_data_ptr \ char list \ (_, unit) dom_prog" - and set_val_locs :: "(_) character_data_ptr \ (_, unit) dom_prog set" + + and set_val :: "(_) character_data_ptr \ char list \ (_, unit) dom_prog" + and set_val_locs :: "(_) character_data_ptr \ (_, unit) dom_prog set" + assumes type_wf_impl: "type_wf = DocumentClass.type_wf" assumes set_val_impl: "set_val = a_set_val" assumes set_val_locs_impl: "set_val_locs = a_set_val_locs" begin -lemma set_val_ok: +lemma set_val_ok: "type_wf h \ character_data_ptr |\| character_data_ptr_kinds h \ h \ ok (set_val character_data_ptr tag)" apply(unfold type_wf_impl) unfolding set_val_impl[unfolded a_set_val_def] using 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_ok put_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_ok - by (metis (no_types, lifting) DocumentClass.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 CharacterDataMonad.get_M_pure - bind_is_OK_E bind_is_OK_pure_I is_OK_returns_result_I) + by (metis (no_types, lifting) DocumentClass.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 CharacterDataMonad.get_M_pure + bind_is_OK_E bind_is_OK_pure_I is_OK_returns_result_I) lemma set_val_writes: "writes (set_val_locs character_data_ptr) (set_val character_data_ptr tag) h h'" - by(auto simp add: set_val_impl[unfolded a_set_val_def] set_val_locs_impl[unfolded a_set_val_locs_def] - intro: writes_bind_pure) + by(auto simp add: set_val_impl[unfolded a_set_val_def] set_val_locs_impl[unfolded a_set_val_locs_def] + intro: writes_bind_pure) lemma set_val_pointers_preserved: assumes "w \ set_val_locs character_data_ptr" @@ -1755,20 +1770,20 @@ lemma set_val_typess_preserved: end locale l_set_val = l_type_wf + l_set_val_defs + - assumes set_val_writes: + assumes set_val_writes: "writes (set_val_locs character_data_ptr) (set_val character_data_ptr tag) h h'" - assumes set_val_ok: + assumes set_val_ok: "type_wf h \ character_data_ptr |\| character_data_ptr_kinds h \ h \ ok (set_val character_data_ptr tag)" - assumes set_val_pointers_preserved: + assumes set_val_pointers_preserved: "w \ set_val_locs character_data_ptr \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" - assumes set_val_types_preserved: + assumes set_val_types_preserved: "w \ set_val_locs character_data_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" global_interpretation l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines set_val = l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_val and set_val_locs = l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_val_locs . -interpretation +interpretation i_set_val?: l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_val set_val_locs apply(unfold_locales) by (auto simp add: set_val_def set_val_locs_def) @@ -1785,19 +1800,19 @@ locale l_set_val_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_val_get_child_nodes: +lemma set_val_get_child_nodes: "\w \ set_val_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" - by(auto simp add: set_val_locs_impl[unfolded a_set_val_locs_def] - get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def) + by(auto simp add: set_val_locs_impl[unfolded a_set_val_locs_def] + get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def) end locale l_set_val_get_child_nodes = l_set_val + l_get_child_nodes + - assumes set_val_get_child_nodes: + assumes set_val_get_child_nodes: "\w \ set_val_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_child_nodes_locs ptr'. r h h'))" interpretation - i_set_val_get_child_nodes?: l_set_val_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_val set_val_locs known_ptr - get_child_nodes get_child_nodes_locs + i_set_val_get_child_nodes?: l_set_val_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_val set_val_locs known_ptr + get_child_nodes get_child_nodes_locs by unfold_locales declare l_set_val_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -1815,25 +1830,26 @@ locale l_set_val_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\ l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M begin -lemma set_val_get_disconnected_nodes: +lemma set_val_get_disconnected_nodes: "\w \ set_val_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" - by(auto simp add: set_val_locs_impl[unfolded a_set_val_locs_def] - get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] - all_args_def) + by(auto simp add: set_val_locs_impl[unfolded a_set_val_locs_def] + get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] + all_args_def) end locale l_set_val_get_disconnected_nodes = l_set_val + l_get_disconnected_nodes + - assumes set_val_get_disconnected_nodes: - "\w \ set_val_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" + assumes set_val_get_disconnected_nodes: + "\w \ set_val_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_disconnected_nodes_locs ptr'. r h h'))" interpretation - i_set_val_get_disconnected_nodes?: l_set_val_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_val - set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + i_set_val_get_disconnected_nodes?: l_set_val_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_val + set_val_locs get_disconnected_nodes get_disconnected_nodes_locs by unfold_locales declare l_set_val_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma set_val_get_disconnected_nodes_is_l_set_val_get_disconnected_nodes [instances]: - "l_set_val_get_disconnected_nodes type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs" + "l_set_val_get_disconnected_nodes type_wf set_val set_val_locs get_disconnected_nodes +get_disconnected_nodes_locs" using set_val_is_l_set_val get_disconnected_nodes_is_l_get_disconnected_nodes apply(simp add: l_set_val_get_disconnected_nodes_def l_set_val_get_disconnected_nodes_axioms_def) using set_val_get_disconnected_nodes @@ -1846,7 +1862,7 @@ subsubsection \get\_parent\ locale l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_child_nodes_defs get_child_nodes get_child_nodes_locs for get_child_nodes :: "(_::linorder) object_ptr \ (_, (_) node_ptr list) dom_prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin definition a_get_parent :: "(_) node_ptr \ (_, (_::linorder) object_ptr option) dom_prog" where @@ -1861,7 +1877,7 @@ definition a_get_parent :: "(_) node_ptr \ (_, (_::linorder) object_ else return (Some (hd parent_ptrs))) }" -definition +definition "a_get_parent_locs \ (\ptr. get_child_nodes_locs ptr \ {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr RObject.nothing)})" end @@ -1875,12 +1891,12 @@ locale l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^su l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs + l_get_parent_defs get_parent get_parent_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes (* :: "(_) object_ptr \ (_, (_) node_ptr list) dom_prog" *) - and get_child_nodes_locs (* :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" *) - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs (* :: "((_) heap \ (_) heap \ bool) set" *) + + and type_wf :: "(_) heap \ bool" + and get_child_nodes (* :: "(_) object_ptr \ (_, (_) node_ptr list) dom_prog" *) + and get_child_nodes_locs (* :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" *) + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs (* :: "((_) heap \ (_) heap \ bool) set" *) + assumes get_parent_impl: "get_parent = a_get_parent" assumes get_parent_locs_impl: "get_parent_locs = a_get_parent_locs" begin @@ -1897,8 +1913,8 @@ lemma get_parent_ok [simp]: assumes "ptr |\| node_ptr_kinds h" shows "h \ ok (get_parent ptr)" using assms get_child_nodes_ok get_child_nodes_pure - by(auto simp add: get_parent_impl[unfolded a_get_parent_def] known_ptrs_known_ptr - intro!: bind_is_OK_pure_I filter_M_pure_I filter_M_is_OK_I bind_pure_I) + by(auto simp add: get_parent_impl[unfolded a_get_parent_def] known_ptrs_known_ptr + intro!: bind_is_OK_pure_I filter_M_pure_I filter_M_is_OK_I bind_pure_I) lemma get_parent_ptr_in_heap [simp]: "h \ ok (get_parent node_ptr) \ node_ptr |\| node_ptr_kinds h" using get_parent_def is_OK_returns_result_I check_in_heap_ptr_in_heap @@ -1908,68 +1924,68 @@ lemma get_parent_parent_in_heap: assumes "h \ get_parent child_node \\<^sub>r Some parent" shows "parent |\| object_ptr_kinds h" using assms get_child_nodes_pure - by(auto simp add: get_parent_def elim!: bind_returns_result_E2 - dest!: filter_M_not_more_elements[where x=parent] - intro!: filter_M_pure_I bind_pure_I - split: if_splits) + by(auto simp add: get_parent_def elim!: bind_returns_result_E2 + dest!: filter_M_not_more_elements[where x=parent] + intro!: filter_M_pure_I bind_pure_I + split: if_splits) lemma get_parent_child_dual: assumes "h \ get_parent child \\<^sub>r Some ptr" obtains children where "h \ get_child_nodes ptr \\<^sub>r children" and "child \ set children" using assms get_child_nodes_pure - by(auto simp add: get_parent_def bind_pure_I - dest!: filter_M_holds_for_result - elim!: bind_returns_result_E2 - intro!: filter_M_pure_I - split: if_splits) + by(auto simp add: get_parent_def bind_pure_I + dest!: filter_M_holds_for_result + elim!: bind_returns_result_E2 + intro!: filter_M_pure_I + split: if_splits) lemma get_parent_reads: "reads get_parent_locs (get_parent node_ptr) h h'" using get_child_nodes_reads[unfolded reads_def] - by(auto simp add: get_parent_def get_parent_locs_def - intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] - reads_subset[OF get_child_nodes_reads] reads_subset[OF return_reads] - reads_subset[OF object_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I bind_pure_I) + by(auto simp add: get_parent_def get_parent_locs_def + intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] + reads_subset[OF get_child_nodes_reads] reads_subset[OF return_reads] + reads_subset[OF object_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I bind_pure_I) lemma get_parent_reads_pointers: "preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr RObject.nothing) \ get_parent_locs" by(auto simp add: get_parent_locs_def) end locale l_get_parent = l_type_wf + l_known_ptrs + l_get_parent_defs + l_get_child_nodes + - assumes get_parent_reads: + assumes get_parent_reads: "reads get_parent_locs (get_parent node_ptr) h h'" - assumes get_parent_ok: + assumes get_parent_ok: "type_wf h \ known_ptrs h \ node_ptr |\| node_ptr_kinds h \ h \ ok (get_parent node_ptr)" - assumes get_parent_ptr_in_heap: + assumes get_parent_ptr_in_heap: "h \ ok (get_parent node_ptr) \ node_ptr |\| node_ptr_kinds h" - assumes get_parent_pure [simp]: + assumes get_parent_pure [simp]: "pure (get_parent node_ptr) h" - assumes get_parent_parent_in_heap: + assumes get_parent_parent_in_heap: "h \ get_parent child_node \\<^sub>r Some parent \ parent |\| object_ptr_kinds h" - assumes get_parent_child_dual: - "h \ get_parent child \\<^sub>r Some ptr \ (\children. h \ get_child_nodes ptr \\<^sub>r children + assumes get_parent_child_dual: + "h \ get_parent child \\<^sub>r Some ptr \ (\children. h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ thesis) \ thesis" - assumes get_parent_reads_pointers: + assumes get_parent_reads_pointers: "preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr RObject.nothing) \ get_parent_locs" -global_interpretation l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs defines +global_interpretation l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs defines get_parent = "l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_parent get_child_nodes" and get_parent_locs = "l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_parent_locs get_child_nodes_locs" . -interpretation - i_get_parent?: l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs - get_parent get_parent_locs +interpretation + i_get_parent?: l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs + get_parent get_parent_locs using instances apply(simp add: l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def) apply(simp add: get_parent_def get_parent_locs_def) done declare l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_parent_is_l_get_parent [instances]: +lemma get_parent_is_l_get_parent [instances]: "l_get_parent type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs" using instances apply(auto simp add: l_get_parent_def l_get_parent_axioms_def)[1] - using get_parent_reads get_parent_ok get_parent_ptr_in_heap get_parent_pure - get_parent_parent_in_heap get_parent_child_dual + using get_parent_reads get_parent_ok get_parent_ptr_in_heap get_parent_pure + get_parent_parent_in_heap get_parent_child_dual using get_parent_reads_pointers by blast+ @@ -1978,32 +1994,32 @@ paragraph \set\_disconnected\_nodes\ locale l_set_disconnected_nodes_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_set_disconnected_nodes_get_child_nodes - set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf set_disconnected_nodes set_disconnected_nodes_locs + type_wf set_disconnected_nodes set_disconnected_nodes_locs + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" begin -lemma set_disconnected_nodes_get_parent [simp]: +lemma set_disconnected_nodes_get_parent [simp]: "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_parent_locs. r h h'))" by(auto simp add: get_parent_locs_def set_disconnected_nodes_locs_def all_args_def) end locale l_set_disconnected_nodes_get_parent = l_set_disconnected_nodes_defs + l_get_parent_defs + - assumes set_disconnected_nodes_get_parent [simp]: - "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_parent_locs. r h h'))" + assumes set_disconnected_nodes_get_parent [simp]: + "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_parent_locs. r h h'))" interpretation i_set_disconnected_nodes_get_parent?: - l_set_disconnected_nodes_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf set_disconnected_nodes + l_set_disconnected_nodes_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs using instances by (simp add: l_set_disconnected_nodes_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) @@ -2020,9 +2036,9 @@ subsubsection \get\_root\_node\ locale l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_parent_defs get_parent get_parent_locs for get_parent :: "(_) node_ptr \ ((_) heap, exception, (_::linorder) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" begin -partial_function (dom_prog) +partial_function (dom_prog) a_get_ancestors :: "(_::linorder) object_ptr \ (_, (_) object_ptr list) dom_prog" where "a_get_ancestors ptr = do { @@ -2053,7 +2069,7 @@ locale l_get_ancestors_defs = fixes get_ancestors :: "(_::linorder) object_ptr \ (_, (_) object_ptr list) dom_prog" fixes get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" -locale l_get_root_node_defs = +locale l_get_root_node_defs = fixes get_root_node :: "(_) object_ptr \ (_, (_) object_ptr) dom_prog" fixes get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" @@ -2070,8 +2086,8 @@ begin lemmas get_ancestors_def = a_get_ancestors.simps[folded get_ancestors_impl] lemmas get_ancestors_locs_def = a_get_ancestors_locs_def[folded get_ancestors_locs_impl] lemmas get_root_node_def = a_get_root_node_def[folded get_root_node_impl get_ancestors_impl] -lemmas get_root_node_locs_def = a_get_root_node_locs_def[folded get_root_node_locs_impl - get_ancestors_locs_impl] +lemmas get_root_node_locs_def = a_get_root_node_locs_def[folded get_root_node_locs_impl + get_ancestors_locs_impl] lemma get_ancestors_pure [simp]: "pure (get_ancestors ptr) h" @@ -2089,11 +2105,11 @@ proof - case (3 f) then show ?case using get_parent_pure - apply(auto simp add: pure_returns_heap_eq pure_def - split: option.splits - elim!: bind_returns_heap_E bind_returns_result_E - dest!: pure_returns_heap_eq[rotated, OF check_in_heap_pure])[1] - apply (meson option.simps(3) returns_result_eq) + apply(auto simp add: pure_returns_heap_eq pure_def + split: option.splits + elim!: bind_returns_heap_E bind_returns_result_E + dest!: pure_returns_heap_eq[rotated, OF check_in_heap_pure])[1] + apply (meson option.simps(3) returns_result_eq) by (metis get_parent_pure pure_returns_heap_eq) qed then show ?thesis @@ -2108,15 +2124,15 @@ lemma get_root_node_pure [simp]: "pure (get_root_node ptr) h" lemma get_ancestors_ptr_in_heap: assumes "h \ ok (get_ancestors ptr)" shows "ptr |\| object_ptr_kinds h" - using assms - by(auto simp add: get_ancestors_def check_in_heap_ptr_in_heap - elim!: bind_is_OK_E dest: is_OK_returns_result_I) + using assms + by(auto simp add: get_ancestors_def check_in_heap_ptr_in_heap + elim!: bind_is_OK_E dest: is_OK_returns_result_I) lemma get_ancestors_ptr: assumes "h \ get_ancestors ptr \\<^sub>r ancestors" shows "ptr \ set ancestors" using assms - apply(simp add: get_ancestors_def) + apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits intro!: bind_pure_I) lemma get_ancestors_not_node: @@ -2124,13 +2140,13 @@ lemma get_ancestors_not_node: assumes "\is_node_ptr_kind ptr" shows "ancestors = [ptr]" using assms - apply(simp add: get_ancestors_def) + apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits) -lemma get_root_node_no_parent: +lemma get_root_node_no_parent: "h \ get_parent node_ptr \\<^sub>r None \ h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" - apply(auto simp add: check_in_heap_def get_root_node_def get_ancestors_def - intro!: bind_pure_returns_result_I )[1] + apply(auto simp add: check_in_heap_def get_root_node_def get_ancestors_def + intro!: bind_pure_returns_result_I )[1] using get_parent_ptr_in_heap by blast end @@ -2141,23 +2157,23 @@ locale l_get_ancestors = l_get_ancestors_defs + assumes get_ancestors_ptr: "h \ get_ancestors ptr \\<^sub>r ancestors \ ptr \ set ancestors" locale l_get_root_node = l_get_root_node_defs + l_get_parent_defs + - assumes get_root_node_pure[simp]: - "pure (get_root_node ptr) h" - assumes get_root_node_no_parent: - "h \ get_parent node_ptr \\<^sub>r None \ h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" + assumes get_root_node_pure[simp]: + "pure (get_root_node ptr) h" + assumes get_root_node_no_parent: + "h \ get_parent node_ptr \\<^sub>r None \ h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" global_interpretation l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs defines get_root_node = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_root_node get_parent" - and get_root_node_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_root_node_locs get_parent_locs" - and get_ancestors = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors get_parent" - and get_ancestors_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors_locs get_parent_locs" + and get_root_node_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_root_node_locs get_parent_locs" + and get_ancestors = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors get_parent" + and get_ancestors_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors_locs get_parent_locs" . declare a_get_ancestors.simps [code] -interpretation - i_get_root_node?: l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs get_parent get_parent_locs - get_child_nodes get_child_nodes_locs get_ancestors get_ancestors_locs - get_root_node get_root_node_locs +interpretation + i_get_root_node?: l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs get_parent get_parent_locs + get_child_nodes get_child_nodes_locs get_ancestors get_ancestors_locs + get_root_node get_root_node_locs using instances apply(simp add: l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def) by(simp add: get_root_node_def get_root_node_locs_def get_ancestors_def get_ancestors_locs_def) @@ -2178,44 +2194,44 @@ paragraph \set\_disconnected\_nodes\ locale l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_set_disconnected_nodes_get_parent - set_disconnected_nodes set_disconnected_nodes_locs get_parent get_parent_locs + set_disconnected_nodes set_disconnected_nodes_locs get_parent get_parent_locs + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs - get_ancestors get_ancestors_locs get_root_node get_root_node_locs + 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 + l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf set_disconnected_nodes set_disconnected_nodes_locs + type_wf set_disconnected_nodes set_disconnected_nodes_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and type_wf :: "(_) heap \ bool" - and known_ptrs :: "(_) heap \ bool" - and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" - and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" - and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and known_ptrs :: "(_) heap \ bool" + and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" + and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" + and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" begin -lemma set_disconnected_nodes_get_ancestors: +lemma set_disconnected_nodes_get_ancestors: "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_ancestors_locs. r h h'))" - by(auto simp add: get_parent_locs_def set_disconnected_nodes_locs_def get_ancestors_locs_def - all_args_def) + by(auto simp add: get_parent_locs_def set_disconnected_nodes_locs_def get_ancestors_locs_def + all_args_def) end locale l_set_disconnected_nodes_get_ancestors = l_set_disconnected_nodes_defs + l_get_ancestors_defs + - assumes set_disconnected_nodes_get_ancestors: + assumes set_disconnected_nodes_get_ancestors: "\w \ set_disconnected_nodes_locs ptr. (h \ w \\<^sub>h h' \ (\r \ get_ancestors_locs. r h h'))" interpretation - i_set_disconnected_nodes_get_ancestors?: l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr - set_disconnected_nodes set_disconnected_nodes_locs - get_child_nodes get_child_nodes_locs get_parent - get_parent_locs type_wf known_ptrs get_ancestors - get_ancestors_locs get_root_node get_root_node_locs + i_set_disconnected_nodes_get_ancestors?: l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr + set_disconnected_nodes set_disconnected_nodes_locs + get_child_nodes get_child_nodes_locs get_parent + get_parent_locs type_wf known_ptrs get_ancestors + get_ancestors_locs get_root_node get_root_node_locs using instances - by (simp add: l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) + by (simp add: l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_set_disconnected_nodes_get_ancestors\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -2229,18 +2245,18 @@ lemma set_disconnected_nodes_get_ancestors_is_l_set_disconnected_nodes_get_ances subsubsection \get\_owner\_document\ - + locale l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_get_root_node_defs get_root_node get_root_node_locs for get_root_node :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" - and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin definition a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \ unit \ (_, (_) document_ptr) dom_prog" - where + where "a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr _ = do { root \ get_root_node (cast node_ptr); (case cast root of @@ -2255,18 +2271,18 @@ definition a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\ }) }" -definition +definition 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 \ unit \ (_, (_) document_ptr) dom_prog" where "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 _ = do { document_ptrs \ document_ptr_kinds_M; (if document_ptr \ set document_ptrs then return document_ptr else error SegmentationFault)}" -definition - a_get_owner_document_tups :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ unit +definition + a_get_owner_document_tups :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ unit \ (_, (_) document_ptr) dom_prog)) list" where - "a_get_owner_document_tups = [ + "a_get_owner_document_tups = [ (is_element_ptr, a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \ the \ cast), (is_character_data_ptr, a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \ the \ cast), (is_document_ptr, 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) @@ -2279,21 +2295,21 @@ end locale l_get_owner_document_defs = fixes get_owner_document :: "(_::linorder) object_ptr \ (_, (_) document_ptr) dom_prog" - + locale l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_known_ptr known_ptr + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + l_get_root_node get_root_node get_root_node_locs + - l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node get_root_node_locs get_disconnected_nodes - get_disconnected_nodes_locs + + l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node get_root_node_locs get_disconnected_nodes + get_disconnected_nodes_locs + l_get_owner_document_defs get_owner_document for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" - and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" - and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" + + and type_wf :: "(_) heap \ bool" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" + and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" + and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" + assumes known_ptr_impl: "known_ptr = a_known_ptr" assumes get_owner_document_impl: "get_owner_document = a_get_owner_document" begin @@ -2304,68 +2320,68 @@ lemma get_owner_document_split: "P (invoke (a_get_owner_document_tups @ xs) ptr ()) = ((known_ptr ptr \ P (get_owner_document ptr)) \ (\(known_ptr ptr) \ P (invoke xs ptr ())))" - by(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_def - CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs - NodeClass.known_ptr_defs - split: invoke_splits option.splits) + by(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_def + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs + NodeClass.known_ptr_defs + split: invoke_splits option.splits) lemma get_owner_document_split_asm: "P (invoke (a_get_owner_document_tups @ xs) ptr ()) = (\((known_ptr ptr \ \P (get_owner_document ptr)) \ (\(known_ptr ptr) \ \P (invoke xs ptr ()))))" - by(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_def - CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs - NodeClass.known_ptr_defs - split: invoke_splits) + by(auto simp add: get_owner_document_def a_get_owner_document_tups_def known_ptr_def + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs + NodeClass.known_ptr_defs + split: invoke_splits) lemmas get_owner_document_splits = get_owner_document_split get_owner_document_split_asm lemma get_owner_document_pure [simp]: "pure (get_owner_document ptr) h" proof - have "\node_ptr. pure (a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr ()) h" - by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def - intro!: bind_pure_I filter_M_pure_I - split: option.splits) + by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def + intro!: bind_pure_I filter_M_pure_I + split: option.splits) moreover have "\document_ptr. pure (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 ()) 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 bind_pure_I) ultimately show ?thesis - by(auto simp add: get_owner_document_def a_get_owner_document_tups_def - intro!: bind_pure_I - split: invoke_splits) + by(auto simp add: get_owner_document_def a_get_owner_document_tups_def + intro!: bind_pure_I + split: invoke_splits) qed lemma get_owner_document_ptr_in_heap: assumes "h \ ok (get_owner_document ptr)" shows "ptr |\| object_ptr_kinds h" - using assms + using assms by(auto simp add: get_owner_document_def invoke_ptr_in_heap dest: is_OK_returns_heap_I) end locale l_get_owner_document = l_get_owner_document_defs + - assumes get_owner_document_ptr_in_heap: + assumes get_owner_document_ptr_in_heap: "h \ ok (get_owner_document ptr) \ ptr |\| object_ptr_kinds h" - assumes get_owner_document_pure [simp]: + assumes get_owner_document_pure [simp]: "pure (get_owner_document ptr) h" -global_interpretation l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node get_root_node_locs - get_disconnected_nodes get_disconnected_nodes_locs - defines get_owner_document_tups = - "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document_tups get_root_node get_disconnected_nodes" - and get_owner_document = - "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document get_root_node get_disconnected_nodes" - and get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r = - "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r get_root_node get_disconnected_nodes" +global_interpretation l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node get_root_node_locs + get_disconnected_nodes get_disconnected_nodes_locs + defines get_owner_document_tups = + "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document_tups get_root_node get_disconnected_nodes" + and get_owner_document = + "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document get_root_node get_disconnected_nodes" + and get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r = + "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r get_root_node get_disconnected_nodes" . interpretation - i_get_owner_document?: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs known_ptr type_wf - get_disconnected_nodes get_disconnected_nodes_locs get_root_node - get_root_node_locs get_owner_document + i_get_owner_document?: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs known_ptr type_wf + get_disconnected_nodes get_disconnected_nodes_locs get_root_node + get_root_node_locs get_owner_document using instances - apply(auto simp add: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def)[1] + apply(auto simp add: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def)[1] by(auto simp add: get_owner_document_tups_def get_owner_document_def get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def)[1] declare l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_owner_document_is_l_get_owner_document [instances]: +lemma get_owner_document_is_l_get_owner_document [instances]: "l_get_owner_document get_owner_document" using get_owner_document_ptr_in_heap by(auto simp add: l_get_owner_document_def) @@ -2380,16 +2396,16 @@ locale l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^ l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs for get_child_nodes :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" - and 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 get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" + and 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" begin definition a_remove_child :: "(_) object_ptr \ (_) node_ptr \ (_, unit) dom_prog" where @@ -2407,7 +2423,7 @@ definition a_remove_child :: "(_) object_ptr \ (_) node_ptr \ (_) document_ptr \ (_, unit) dom_prog set" where - "a_remove_child_locs ptr owner_document = set_child_nodes_locs ptr + "a_remove_child_locs ptr owner_document = set_child_nodes_locs ptr \ set_disconnected_nodes_locs owner_document" definition a_remove :: "(_) node_ptr \ (_, unit) dom_prog" @@ -2427,7 +2443,7 @@ locale l_remove_child_defs = fixes remove_child :: "(_::linorder) object_ptr \ (_) node_ptr \ (_, unit) dom_prog" fixes remove_child_locs :: "(_) object_ptr \ (_) document_ptr \ (_, unit) dom_prog set" -locale l_remove_defs = +locale l_remove_defs = fixes remove :: "(_) node_ptr \ (_, unit) dom_prog" locale l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = @@ -2459,7 +2475,7 @@ proof - using assms calculation by(auto simp add: remove_child_def elim!: bind_is_OK_E2) ultimately show ?thesis - using assms(1) get_child_nodes_ptr_in_heap by blast + using assms(1) get_child_nodes_ptr_in_heap by blast qed @@ -2467,7 +2483,9 @@ 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] + 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) @@ -2483,32 +2501,34 @@ proof - h2: "h \ set_disconnected_nodes owner_document (child # prev_disc_nodes) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr (remove1 child children) \\<^sub>h h'" using assms(1) - apply(auto simp add: remove_child_def - elim!: bind_returns_heap_E - dest!: returns_result_eq[OF assms(2)] pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits)[1] + apply(auto simp add: remove_child_def + elim!: bind_returns_heap_E + dest!: returns_result_eq[OF assms(2)] + pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits)[1] by (metis get_disconnected_nodes_pure pure_returns_heap_eq) have "h2 \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" - apply(rule reads_writes_separate_backwards[OF get_disconnected_nodes_reads - set_child_nodes_writes h' assms(3)]) + apply(rule reads_writes_separate_backwards[OF get_disconnected_nodes_reads + set_child_nodes_writes h' assms(3)]) by (simp add: set_child_nodes_get_disconnected_nodes) then show ?thesis - by (metis (no_types, lifting) h2 set_disconnected_nodes_get_disconnected_nodes - list.set_intros(1) select_result_I2) + by (metis (no_types, lifting) h2 set_disconnected_nodes_get_disconnected_nodes + list.set_intros(1) select_result_I2) qed -lemma remove_child_writes [simp]: +lemma remove_child_writes [simp]: "writes (remove_child_locs ptr |h \ get_owner_document (cast child)|\<^sub>r) (remove_child ptr child) h h'" - apply(auto simp add: remove_child_def intro!: writes_bind_pure[OF get_child_nodes_pure] - writes_bind_pure[OF get_owner_document_pure] - writes_bind_pure[OF get_disconnected_nodes_pure])[1] - by(auto simp add: remove_child_locs_def set_disconnected_nodes_writes writes_union_right_I - set_child_nodes_writes writes_union_left_I - intro!: writes_bind) + apply(auto simp add: remove_child_def intro!: writes_bind_pure[OF get_child_nodes_pure] + writes_bind_pure[OF get_owner_document_pure] + writes_bind_pure[OF get_disconnected_nodes_pure])[1] + by(auto simp add: remove_child_locs_def set_disconnected_nodes_writes writes_union_right_I + set_child_nodes_writes writes_union_left_I + intro!: writes_bind) -lemma remove_writes: - "writes (remove_child_locs (the |h \ get_parent child|\<^sub>r) |h \ get_owner_document (cast child)|\<^sub>r) (remove child) h h'" +lemma remove_writes: + "writes (remove_child_locs (the |h \ get_parent child|\<^sub>r) |h \ get_owner_document (cast child)|\<^sub>r) +(remove child) h h'" by(auto simp add: remove_def intro!: writes_bind_pure split: option.splits) lemma remove_child_children_subset: @@ -2526,41 +2546,41 @@ proof - h2: "h \ set_disconnected_nodes owner_document (child # disc_nodes) \\<^sub>h h2" and h': "h2 \ set_child_nodes parent (remove1 child ptr_children) \\<^sub>h h'" using assms(1) - by(auto simp add: remove_child_def - elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_disconnected_nodes_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits) + by(auto simp add: remove_child_def + elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_disconnected_nodes_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits) have "parent |\| object_ptr_kinds h" using get_child_nodes_ptr_in_heap ptr_children by blast 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 set_disconnected_nodes_writes h2]) - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF set_disconnected_nodes_writes h2]) + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) have "type_wf h2" - using type_wf 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 - by(auto simp add: reflp_def transp_def) + using type_wf 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 + by(auto simp add: reflp_def transp_def) have "h2 \ get_child_nodes ptr \\<^sub>r children" - using get_child_nodes_reads set_disconnected_nodes_writes h2 assms(2) - apply(rule reads_writes_separate_forwards) - by (simp add: set_disconnected_nodes_get_child_nodes) + using get_child_nodes_reads set_disconnected_nodes_writes h2 assms(2) + apply(rule reads_writes_separate_forwards) + by (simp add: set_disconnected_nodes_get_child_nodes) moreover have "h2 \ get_child_nodes parent \\<^sub>r ptr_children" using get_child_nodes_reads set_disconnected_nodes_writes h2 ptr_children - apply(rule reads_writes_separate_forwards) - by (simp add: set_disconnected_nodes_get_child_nodes) - moreover have - "ptr \ parent \ h2 \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" - using get_child_nodes_reads set_child_nodes_writes h' - apply(rule reads_writes_preserved) - by (metis set_child_nodes_get_child_nodes_different_pointers) + apply(rule reads_writes_separate_forwards) + by (simp add: set_disconnected_nodes_get_child_nodes) + moreover have + "ptr \ parent \ h2 \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" + using get_child_nodes_reads set_child_nodes_writes h' + apply(rule reads_writes_preserved) + by (metis set_child_nodes_get_child_nodes_different_pointers) moreover have "h' \ get_child_nodes parent \\<^sub>r remove1 child ptr_children" - using h' set_child_nodes_get_child_nodes known_ptrs type_wf known_ptrs_known_ptr - \parent |\| object_ptr_kinds h\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ - by fast + using h' set_child_nodes_get_child_nodes known_ptrs type_wf known_ptrs_known_ptr + \parent |\| object_ptr_kinds h\ \object_ptr_kinds h = object_ptr_kinds h2\ \type_wf h2\ + by fast moreover have "set ( remove1 child ptr_children) \ set ptr_children" by (simp add: set_remove1_subset) ultimately show ?thesis @@ -2589,14 +2609,15 @@ lemma remove_child_types_preserved: by auto end -locale l_remove_child = l_type_wf + l_known_ptrs + l_remove_child_defs + l_get_owner_document_defs - + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + - assumes remove_child_writes: - "writes (remove_child_locs object_ptr |h \ get_owner_document (cast child)|\<^sub>r) (remove_child object_ptr child) h h'" - assumes remove_child_pointers_preserved: - "w \ remove_child_locs ptr owner_document \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" - assumes remove_child_types_preserved: - "w \ remove_child_locs ptr owner_document \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" +locale l_remove_child = l_type_wf + l_known_ptrs + l_remove_child_defs + l_get_owner_document_defs + + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + + assumes remove_child_writes: + "writes (remove_child_locs object_ptr |h \ get_owner_document (cast child)|\<^sub>r) +(remove_child object_ptr child) h h'" + assumes remove_child_pointers_preserved: + "w \ remove_child_locs ptr owner_document \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" + assumes remove_child_types_preserved: + "w \ remove_child_locs ptr owner_document \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" assumes remove_child_in_disconnected_nodes: "known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' \ h \ get_owner_document (cast child) \\<^sub>r owner_document @@ -2613,33 +2634,33 @@ locale l_remove_child = l_type_wf + l_known_ptrs + l_remove_child_defs + l_get_o locale l_remove -global_interpretation l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_parent get_parent_locs - get_owner_document get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs - defines remove = - "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove get_child_nodes set_child_nodes get_parent get_owner_document +global_interpretation l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_parent get_parent_locs + get_owner_document get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + defines remove = + "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove get_child_nodes set_child_nodes get_parent get_owner_document get_disconnected_nodes set_disconnected_nodes" - and remove_child = - "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove_child get_child_nodes set_child_nodes get_owner_document + and remove_child = + "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove_child get_child_nodes set_child_nodes get_owner_document get_disconnected_nodes set_disconnected_nodes" - and remove_child_locs = + and remove_child_locs = "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove_child_locs set_child_nodes_locs set_disconnected_nodes_locs" - . + . interpretation - i_remove_child?: l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_parent get_parent_locs get_owner_document - get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf - known_ptr known_ptrs + i_remove_child?: l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_parent get_parent_locs get_owner_document + get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf + known_ptr known_ptrs using instances apply(simp add: l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def) by(simp add: remove_child_def remove_child_locs_def remove_def) declare l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma remove_child_is_l_remove_child [instances]: - "l_remove_child type_wf known_ptr known_ptrs remove_child remove_child_locs get_owner_document +lemma remove_child_is_l_remove_child [instances]: + "l_remove_child type_wf known_ptr known_ptrs remove_child remove_child_locs get_owner_document get_child_nodes get_disconnected_nodes" using instances apply(auto simp add: l_remove_child_def l_remove_child_axioms_def)[1] (*slow, ca 1min *) @@ -2664,14 +2685,14 @@ locale l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^su l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs for get_owner_document :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and remove_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and remove_child_locs :: "(_) object_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and remove_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and remove_child_locs :: "(_) object_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + 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" begin definition a_adopt_node :: "(_) document_ptr \ (_) node_ptr \ (_, unit) dom_prog" where @@ -2694,70 +2715,70 @@ definition a_adopt_node :: "(_) document_ptr \ (_) node_ptr \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" where - "a_adopt_node_locs parent owner_document document_ptr = - ((if parent = None - then {} - else remove_child_locs (the parent) owner_document) \ set_disconnected_nodes_locs document_ptr + "a_adopt_node_locs parent owner_document document_ptr = + ((if parent = None + then {} + else remove_child_locs (the parent) owner_document) \ set_disconnected_nodes_locs document_ptr \ set_disconnected_nodes_locs owner_document)" end locale l_adopt_node_defs = - fixes - adopt_node :: "(_) document_ptr \ (_) node_ptr \ (_, unit) dom_prog" - fixes - adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" + fixes + adopt_node :: "(_) document_ptr \ (_) node_ptr \ (_, unit) dom_prog" + fixes + adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" -global_interpretation l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_owner_document get_parent get_parent_locs remove_child - remove_child_locs get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs - defines adopt_node = "l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_adopt_node get_owner_document get_parent remove_child +global_interpretation l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_owner_document get_parent get_parent_locs remove_child + remove_child_locs get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + defines adopt_node = "l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_adopt_node get_owner_document get_parent remove_child get_disconnected_nodes set_disconnected_nodes" - and adopt_node_locs = "l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_adopt_node_locs + and adopt_node_locs = "l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_adopt_node_locs remove_child_locs set_disconnected_nodes_locs" . locale l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs - get_owner_document get_parent get_parent_locs remove_child remove_child_locs get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + get_owner_document get_parent get_parent_locs remove_child remove_child_locs get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + l_adopt_node_defs - adopt_node adopt_node_locs + adopt_node adopt_node_locs + l_get_owner_document - get_owner_document + get_owner_document + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs get_parent - get_parent_locs get_owner_document get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf - known_ptr known_ptrs + get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs get_parent + get_parent_locs get_owner_document get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf + known_ptr known_ptrs + l_set_disconnected_nodes_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs for get_owner_document :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and remove_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and remove_child_locs :: "(_) object_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - 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 adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and remove_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and remove_child_locs :: "(_) object_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + 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 adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" - and known_ptr :: "(_) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" - and remove :: "(_) node_ptr \ ((_) heap, exception, unit) prog" + + and known_ptr :: "(_) object_ptr \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" + and remove :: "(_) node_ptr \ ((_) heap, exception, unit) prog" + assumes adopt_node_impl: "adopt_node = a_adopt_node" assumes adopt_node_locs_impl: "adopt_node_locs = a_adopt_node_locs" begin @@ -2765,17 +2786,17 @@ lemmas adopt_node_def = a_adopt_node_def[folded adopt_node_impl] lemmas adopt_node_locs_def = a_adopt_node_locs_def[folded adopt_node_locs_impl] lemma adopt_node_writes: - shows "writes (adopt_node_locs |h \ get_parent node|\<^sub>r |h + shows "writes (adopt_node_locs |h \ get_parent node|\<^sub>r |h \ get_owner_document (cast node)|\<^sub>r document_ptr) (adopt_node document_ptr node) h h'" - apply(auto simp add: adopt_node_def adopt_node_locs_def - intro!: writes_bind_pure[OF get_owner_document_pure] writes_bind_pure[OF get_parent_pure] - writes_bind_pure[OF get_disconnected_nodes_pure] - split: option.splits)[1] - apply(auto intro!: writes_bind)[1] - apply (simp add: set_disconnected_nodes_writes writes_union_right_I) + apply(auto simp add: adopt_node_def adopt_node_locs_def + intro!: writes_bind_pure[OF get_owner_document_pure] writes_bind_pure[OF get_parent_pure] + writes_bind_pure[OF get_disconnected_nodes_pure] + split: option.splits)[1] + apply(auto intro!: writes_bind)[1] + apply (simp add: set_disconnected_nodes_writes writes_union_right_I) apply (simp add: set_disconnected_nodes_writes writes_union_left_I writes_union_right_I) apply(auto intro!: writes_bind)[1] - apply (metis (no_types, lifting) remove_child_writes select_result_I2 writes_union_left_I) + apply (metis (no_types, lifting) remove_child_writes select_result_I2 writes_union_left_I) apply (simp add: set_disconnected_nodes_writes writes_union_right_I) by(auto intro: writes_subset[OF set_disconnected_nodes_writes] writes_subset[OF remove_child_writes]) @@ -2790,7 +2811,8 @@ proof - obtain old_document parent_opt h2 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" + 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; @@ -2799,10 +2821,10 @@ proof - set_disconnected_nodes owner_document (node # disc_nodes) } else do { return () }) \\<^sub>h h'" using assms(1) - 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]) + by(auto simp add: adopt_node_def + elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) have "h2 \ get_child_nodes ptr \\<^sub>r children'" proof (cases "owner_document \ old_document") @@ -2813,8 +2835,8 @@ proof - 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] ) + by(auto elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) have "h3 \ get_child_nodes ptr \\<^sub>r children'" using get_child_nodes_reads set_disconnected_nodes_writes h' assms(3) apply(rule reads_writes_separate_backwards) @@ -2837,8 +2859,9 @@ proof - by(auto dest!: returns_result_eq[OF \h2 \ get_child_nodes ptr \\<^sub>r children'\]) next case (Some option) - then show ?case - using assms(2) \h2 \ get_child_nodes ptr \\<^sub>r children'\ remove_child_children_subset known_ptrs type_wf + then show ?case + using assms(2) \h2 \ get_child_nodes ptr \\<^sub>r children'\ remove_child_children_subset known_ptrs + type_wf by simp qed qed @@ -2872,46 +2895,47 @@ lemma adopt_node_types_preserved: by (auto split: if_splits) end -locale l_adopt_node = l_type_wf + l_known_ptrs + l_get_parent_defs + l_adopt_node_defs + l_get_child_nodes_defs + l_get_owner_document_defs + - assumes adopt_node_writes: - "writes (adopt_node_locs |h \ get_parent node|\<^sub>r +locale l_adopt_node = l_type_wf + l_known_ptrs + l_get_parent_defs + l_adopt_node_defs + + l_get_child_nodes_defs + l_get_owner_document_defs + + assumes adopt_node_writes: + "writes (adopt_node_locs |h \ get_parent node|\<^sub>r |h \ get_owner_document (cast node)|\<^sub>r document_ptr) (adopt_node document_ptr node) h h'" - assumes adopt_node_pointers_preserved: - "w \ adopt_node_locs parent owner_document document_ptr + assumes adopt_node_pointers_preserved: + "w \ adopt_node_locs parent owner_document document_ptr \ h \ w \\<^sub>h h' \ object_ptr_kinds h = object_ptr_kinds h'" - assumes adopt_node_types_preserved: - "w \ adopt_node_locs parent owner_document document_ptr + assumes adopt_node_types_preserved: + "w \ adopt_node_locs parent owner_document document_ptr \ h \ w \\<^sub>h h' \ type_wf h = type_wf h'" - assumes adopt_node_child_in_heap: - "h \ ok (adopt_node document_ptr child) \ child |\| node_ptr_kinds h" + assumes adopt_node_child_in_heap: + "h \ ok (adopt_node document_ptr child) \ child |\| node_ptr_kinds h" assumes adopt_node_children_subset: - "h \ adopt_node owner_document node \\<^sub>h h' \ h \ get_child_nodes ptr \\<^sub>r children - \ h' \ get_child_nodes ptr \\<^sub>r children' + "h \ adopt_node owner_document node \\<^sub>h h' \ h \ get_child_nodes ptr \\<^sub>r children + \ h' \ get_child_nodes ptr \\<^sub>r children' \ known_ptrs h \ type_wf h \ set children' \ set children" interpretation - i_adopt_node?: l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs remove_child - remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes - set_child_nodes_locs remove + i_adopt_node?: l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs remove_child + remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes + set_child_nodes_locs remove apply(unfold_locales) - by(auto simp add: adopt_node_def adopt_node_locs_def) + by(auto simp add: adopt_node_def adopt_node_locs_def) declare l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma adopt_node_is_l_adopt_node [instances]: - "l_adopt_node type_wf known_ptr known_ptrs get_parent adopt_node adopt_node_locs get_child_nodes +lemma adopt_node_is_l_adopt_node [instances]: + "l_adopt_node type_wf known_ptr known_ptrs get_parent adopt_node adopt_node_locs get_child_nodes get_owner_document" using instances - by (simp add: l_adopt_node_axioms_def adopt_node_child_in_heap adopt_node_children_subset - adopt_node_pointers_preserved adopt_node_types_preserved adopt_node_writes - l_adopt_node_def) + by (simp add: l_adopt_node_axioms_def adopt_node_child_in_heap adopt_node_children_subset + adopt_node_pointers_preserved adopt_node_types_preserved adopt_node_writes + l_adopt_node_def) subsubsection \insert\_before\ - + locale l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_parent_defs get_parent get_parent_locs + l_get_child_nodes_defs get_child_nodes get_child_nodes_locs @@ -2922,21 +2946,21 @@ locale l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\< + l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_get_owner_document_defs get_owner_document for get_parent :: "(_) node_ptr \ ((_) heap, exception, (_::linorder) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" - and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" - and adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" + and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" + and adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" begin definition a_next_sibling :: "(_) node_ptr \ (_, (_) node_ptr option) dom_prog" @@ -2956,8 +2980,8 @@ fun insert_before_list :: "'xyz \ 'xyz option \ 'xyz lis where "insert_before_list v (Some reference) (x#xs) = (if reference = x then v#x#xs else x # insert_before_list v (Some reference) xs)" - | "insert_before_list v (Some _) [] = [v]" - | "insert_before_list v None xs = xs @ [v]" + | "insert_before_list v (Some _) [] = [v]" + | "insert_before_list v None xs = xs @ [v]" definition a_insert_node :: "(_) object_ptr \ (_) node_ptr \ (_) node_ptr option \ (_, unit) dom_prog" @@ -2993,7 +3017,7 @@ definition a_insert_before :: "(_) object_ptr \ (_) node_ptr "a_insert_before ptr node child = do { a_ensure_pre_insertion_validity node ptr child; reference_child \ (if Some node = child - then a_next_sibling node + then a_next_sibling node else return child); owner_document \ get_owner_document ptr; adopt_node owner_document node; @@ -3002,7 +3026,7 @@ definition a_insert_before :: "(_) object_ptr \ (_) node_ptr a_insert_node ptr node reference_child }" -definition a_insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr +definition a_insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" where "a_insert_before_locs ptr old_parent child_owner_document ptr_owner_document = @@ -3013,7 +3037,7 @@ end locale l_insert_before_defs = fixes insert_before :: "(_) object_ptr \ (_) node_ptr \ (_) node_ptr option \ (_, unit) dom_prog" - fixes insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr + fixes insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" locale l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = @@ -3024,57 +3048,58 @@ end locale l_append_child_defs = fixes append_child :: "(_) object_ptr \ (_) node_ptr \ (_, unit) dom_prog" - + locale l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs - 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 + 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 + l_insert_before_defs - insert_before insert_before_locs + insert_before insert_before_locs + l_append_child_defs - append_child + append_child + l_set_child_nodes_get_child_nodes - type_wf known_ptr get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs + type_wf known_ptr get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs + l_get_ancestors - get_ancestors get_ancestors_locs + get_ancestors get_ancestors_locs + l_adopt_node - type_wf known_ptr known_ptrs get_parent get_parent_locs adopt_node adopt_node_locs - get_child_nodes get_child_nodes_locs get_owner_document + type_wf known_ptr known_ptrs get_parent get_parent_locs adopt_node adopt_node_locs + get_child_nodes get_child_nodes_locs get_owner_document + l_set_disconnected_nodes - type_wf set_disconnected_nodes set_disconnected_nodes_locs + type_wf set_disconnected_nodes set_disconnected_nodes_locs + l_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs + l_get_owner_document - get_owner_document + get_owner_document + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_set_disconnected_nodes_get_child_nodes - set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs for get_parent :: "(_) node_ptr \ ((_) heap, exception, (_::linorder) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" - and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" - and adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and set_child_nodes :: "(_) object_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_child_nodes_locs :: "(_) object_ptr \ ((_) heap, exception, unit) prog set" + and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" + and adopt_node :: "(_) document_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and adopt_node_locs :: "(_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" - and insert_before :: "(_) object_ptr \ (_) node_ptr \ (_) node_ptr option \ ((_) heap, exception, unit) prog" - and insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_owner_document :: "(_) object_ptr \ ((_) heap, exception, (_) document_ptr) prog" + and insert_before :: + "(_) object_ptr \ (_) node_ptr \ (_) node_ptr option \ ((_) heap, exception, unit) prog" + and insert_before_locs :: "(_) object_ptr \ (_) object_ptr option \ (_) document_ptr \ (_) document_ptr \ (_, unit) dom_prog set" - and append_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" - and type_wf :: "(_) heap \ bool" - and known_ptr :: "(_) object_ptr \ bool" - and known_ptrs :: "(_) heap \ bool" + + and append_child :: "(_) object_ptr \ (_) node_ptr \ ((_) heap, exception, unit) prog" + and type_wf :: "(_) heap \ bool" + and known_ptr :: "(_) object_ptr \ bool" + and known_ptrs :: "(_) heap \ bool" + assumes insert_before_impl: "insert_before = a_insert_before" assumes insert_before_locs_impl: "insert_before_locs = a_insert_before_locs" begin @@ -3101,16 +3126,16 @@ lemma insert_before_list_node_in_set: "x \ set (insert_before_list x ref xs) apply(induct x ref xs rule: insert_before_list.induct) by(auto) -lemma insert_node_writes: +lemma insert_node_writes: "writes (set_child_nodes_locs ptr) (a_insert_node ptr new_child reference_child_opt) h h'" - by(auto simp add: a_insert_node_def set_child_nodes_writes - intro!: writes_bind_pure[OF get_child_nodes_pure]) + by(auto simp add: a_insert_node_def set_child_nodes_writes + intro!: writes_bind_pure[OF get_child_nodes_pure]) lemma ensure_pre_insertion_validity_pure [simp]: "pure (a_ensure_pre_insertion_validity node ptr child) h" - by(auto simp add: a_ensure_pre_insertion_validity_def - intro!: bind_pure_I - split: option.splits) + by(auto simp add: a_ensure_pre_insertion_validity_def + intro!: bind_pure_I + split: option.splits) lemma insert_before_reference_child_not_in_children: assumes "h \ get_parent child \\<^sub>r Some parent" @@ -3132,19 +3157,20 @@ lemma insert_before_ptr_in_heap: 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) + 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" 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_heap_I - l_get_owner_document.get_owner_document_pure local.adopt_node_child_in_heap - local.l_get_owner_document_axioms next_sibling_pure pure_returns_heap_eq return_pure) + by (metis (mono_tags, lifting) ensure_pre_insertion_validity_pure is_OK_returns_heap_I + l_get_owner_document.get_owner_document_pure local.adopt_node_child_in_heap + local.l_get_owner_document_axioms next_sibling_pure pure_returns_heap_eq return_pure) lemma insert_node_children_remain_distinct: - assumes insert_node: "h \ a_insert_node ptr new_child reference_child_opt \\<^sub>h h2" + assumes insert_node: "h \ a_insert_node ptr new_child reference_child_opt \\<^sub>h h2" and "h \ get_child_nodes ptr \\<^sub>r children" and "new_child \ set children" and "\ptr children. h \ get_child_nodes ptr \\<^sub>r children \ distinct children" @@ -3162,7 +3188,7 @@ proof - using returns_result_eq set_child_nodes_get_child_nodes known_ptr type_wf using pure_returns_heap_eq by fastforce then show ?thesis - using True a1 assms(2) assms(3) assms(4) insert_before_list_distinct returns_result_eq + using True a1 assms(2) assms(3) assms(4) insert_before_list_distinct returns_result_eq by fastforce next case False @@ -3174,30 +3200,30 @@ proof - using assms(4) by blast qed qed - -lemma insert_before_writes: - "writes (insert_before_locs ptr |h \ get_parent child|\<^sub>r + +lemma insert_before_writes: + "writes (insert_before_locs ptr |h \ get_parent child|\<^sub>r |h \ get_owner_document (cast child)|\<^sub>r |h \ get_owner_document ptr|\<^sub>r) (insert_before ptr child ref) h h'" - apply(auto simp add: insert_before_def insert_before_locs_def a_insert_node_def + apply(auto simp add: insert_before_def insert_before_locs_def a_insert_node_def intro!: writes_bind)[1] - apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure local.adopt_node_writes - local.get_owner_document_pure next_sibling_pure pure_returns_heap_eq - select_result_I2 sup_commute writes_union_right_I) - apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure next_sibling_pure - pure_returns_heap_eq select_result_I2 set_disconnected_nodes_writes - writes_union_right_I) + apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure local.adopt_node_writes + local.get_owner_document_pure next_sibling_pure pure_returns_heap_eq + select_result_I2 sup_commute writes_union_right_I) + apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure next_sibling_pure + pure_returns_heap_eq select_result_I2 set_disconnected_nodes_writes + writes_union_right_I) apply (simp add: set_child_nodes_writes writes_union_left_I writes_union_right_I) - apply (metis (no_types, hide_lams) adopt_node_writes ensure_pre_insertion_validity_pure - get_owner_document_pure pure_returns_heap_eq select_result_I2 writes_union_left_I) - apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure pure_returns_heap_eq - select_result_I2 set_disconnected_nodes_writes writes_union_right_I) - by (simp add: set_child_nodes_writes writes_union_left_I writes_union_right_I) + apply (metis (no_types, hide_lams) adopt_node_writes ensure_pre_insertion_validity_pure + get_owner_document_pure pure_returns_heap_eq select_result_I2 writes_union_left_I) + apply (metis (no_types, hide_lams) ensure_pre_insertion_validity_pure pure_returns_heap_eq + select_result_I2 set_disconnected_nodes_writes writes_union_right_I) + by (simp add: set_child_nodes_writes writes_union_left_I writes_union_right_I) end locale l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_append_child_defs + - l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + + l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs + assumes append_child_impl: "append_child = a_append_child" begin @@ -3208,19 +3234,19 @@ locale l_insert_before = l_insert_before_defs locale l_append_child = l_append_child_defs -global_interpretation l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs get_child_nodes - get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors 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 +global_interpretation l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs get_child_nodes + get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors 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 defines next_sibling = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_next_sibling get_parent get_child_nodes" and insert_node = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_insert_node get_child_nodes set_child_nodes" and - ensure_pre_insertion_validity = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_ensure_pre_insertion_validity + ensure_pre_insertion_validity = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_ensure_pre_insertion_validity get_parent get_child_nodes get_ancestors" and - insert_before = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_insert_before get_parent get_child_nodes - set_child_nodes get_ancestors adopt_node set_disconnected_nodes + insert_before = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_insert_before get_parent get_child_nodes + set_child_nodes get_ancestors adopt_node set_disconnected_nodes get_disconnected_nodes get_owner_document" and - insert_before_locs = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_insert_before_locs set_child_nodes_locs + insert_before_locs = "l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_insert_before_locs set_child_nodes_locs adopt_node_locs set_disconnected_nodes_locs" . @@ -3228,11 +3254,11 @@ global_interpretation l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^s defines append_child = "l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_append_child insert_before" . -interpretation - i_insert_before?: l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs get_child_nodes - get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors 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 +interpretation + i_insert_before?: l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs get_child_nodes + get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors 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 apply(simp add: l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances) by (simp add: insert_before_def insert_before_locs_def) @@ -3252,18 +3278,18 @@ locale l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs + l_set_tag_name_defs set_tag_name set_tag_name_locs - for get_disconnected_nodes :: - "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: - "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_disconnected_nodes :: - "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: - "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and set_tag_name :: - "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_tag_name_locs :: - "(_) element_ptr \ ((_) heap, exception, unit) prog set" + for get_disconnected_nodes :: + "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: + "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and set_disconnected_nodes :: + "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: + "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and set_tag_name :: + "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_tag_name_locs :: + "(_) element_ptr \ ((_) heap, exception, unit) prog set" begin definition a_create_element :: "(_) document_ptr \ tag_name \ (_, (_) element_ptr) dom_prog" where @@ -3279,29 +3305,30 @@ end locale l_create_element_defs = fixes create_element :: "(_) document_ptr \ tag_name \ (_, (_) element_ptr) dom_prog" -global_interpretation 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_name set_tag_name_locs - defines - create_element = "l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_create_element get_disconnected_nodes +global_interpretation 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_name set_tag_name_locs + defines + create_element = "l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_create_element get_disconnected_nodes set_disconnected_nodes set_tag_name" . 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 get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_name set_tag_name_locs + + 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_name set_tag_name_locs + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + l_set_tag_name type_wf set_tag_name set_tag_name_locs + l_create_element_defs create_element + l_known_ptr known_ptr for get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" - and type_wf :: "(_) heap \ bool" - and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" - and known_ptr :: "(_) object_ptr \ bool" + + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" + and type_wf :: "(_) heap \ bool" + and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" + and known_ptr :: "(_) object_ptr \ bool" + assumes known_ptr_impl: "known_ptr = a_known_ptr" assumes create_element_impl: "create_element = a_create_element" begin @@ -3322,14 +3349,15 @@ proof - 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] ) + 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_name_writes h3]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_tag_name_writes h3]) using set_tag_name_pointers_preserved by (auto simp add: reflp_def transp_def) moreover have "document_ptr |\| document_ptr_kinds h3" @@ -3349,14 +3377,17 @@ proof - 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) + 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_name set_tag_name_locs type_wf create_element known_ptr + 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_name set_tag_name_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] @@ -3368,11 +3399,11 @@ locale l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\< l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs for set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - 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_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + 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" begin definition a_create_character_data :: "(_) document_ptr \ string \ (_, (_) character_data_ptr) dom_prog" where @@ -3388,31 +3419,32 @@ end locale l_create_character_data_defs = fixes create_character_data :: "(_) document_ptr \ string \ (_, (_) character_data_ptr) dom_prog" -global_interpretation 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 - defines create_character_data = "l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_create_character_data +global_interpretation 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 + defines create_character_data = "l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_create_character_data set_val get_disconnected_nodes set_disconnected_nodes" . 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 set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + + 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" + + 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] +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)" @@ -3429,14 +3461,15 @@ proof - 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] ) + 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]) + 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" @@ -3456,15 +3489,19 @@ proof - 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) + 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 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) + 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] @@ -3490,7 +3527,7 @@ locale l_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O l_create_document_defs + assumes create_document_impl: "create_document = a_create_document" begin -lemmas +lemmas create_document_def = create_document_impl[unfolded create_document_def, unfolded a_create_document_def] end @@ -3507,7 +3544,7 @@ subsubsection \tree\_order\ locale l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_child_nodes_defs get_child_nodes get_child_nodes_locs for get_child_nodes :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin partial_function (dom_prog) a_to_tree_order :: "(_) object_ptr \ (_, (_) object_ptr list) dom_prog" where @@ -3530,10 +3567,10 @@ locale l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\< l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs + l_to_tree_order_defs to_tree_order for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and to_tree_order :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and to_tree_order :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + assumes to_tree_order_impl: "to_tree_order = a_to_tree_order" begin lemmas to_tree_order_def = a_to_tree_order.simps[folded to_tree_order_impl] @@ -3568,9 +3605,9 @@ locale l_to_tree_order = fixes to_tree_order :: "(_) object_ptr \ (_, (_) object_ptr list) dom_prog" assumes to_tree_order_pure [simp]: "pure (to_tree_order ptr) h" -interpretation - i_to_tree_order?: l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs - to_tree_order +interpretation + i_to_tree_order?: l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs + to_tree_order apply(unfold_locales) by (simp add: to_tree_order_def) declare l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -3586,7 +3623,7 @@ locale l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^s l_to_tree_order_defs to_tree_order for to_tree_order :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" begin -definition a_first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr +definition a_first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ (_, 'result option) dom_prog) \ (_, 'result option) dom_prog" where "a_first_in_tree_order ptr f = (do { @@ -3599,7 +3636,7 @@ definition a_first_in_tree_order :: "(_) object_ptr \ ((_) object_pt end locale l_first_in_tree_order_defs = - fixes first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ (_, 'result option) dom_prog) + fixes first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ (_, 'result option) dom_prog) \ (_, 'result option) dom_prog" global_interpretation l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order defines @@ -3609,9 +3646,9 @@ locale l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^s l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order + l_first_in_tree_order_defs first_in_tree_order for to_tree_order :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ ((_) heap, exception, 'result option) prog) + and first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ ((_) heap, exception, 'result option) prog) \ ((_) heap, exception, 'result option) prog" + -assumes first_in_tree_order_impl: "first_in_tree_order = a_first_in_tree_order" + assumes first_in_tree_order_impl: "first_in_tree_order = a_first_in_tree_order" begin lemmas first_in_tree_order_def = first_in_tree_order_impl[unfolded a_first_in_tree_order_def] end @@ -3632,11 +3669,11 @@ locale l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ l_to_tree_order_defs to_tree_order + l_get_attribute_defs get_attribute get_attribute_locs for to_tree_order :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr - \ ((_) heap, exception, (_) element_ptr option) prog) + and first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr + \ ((_) heap, exception, (_) element_ptr option) prog) \ ((_) heap, exception, (_) element_ptr option) prog" - and get_attribute :: "(_) element_ptr \ char list \ ((_) heap, exception, char list option) prog" - and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_attribute :: "(_) element_ptr \ char list \ ((_) heap, exception, char list option) prog" + and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" begin definition a_get_element_by_id :: "(_) object_ptr \ attr_value \ (_, (_) element_ptr option) dom_prog" where @@ -3674,14 +3711,15 @@ locale l_get_element_by_defs = fixes get_elements_by_class_name :: "(_) object_ptr \ attr_value \ (_, (_) element_ptr list) dom_prog" fixes get_elements_by_tag_name :: "(_) object_ptr \ attr_value \ (_, (_) element_ptr list) dom_prog" -global_interpretation -l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order first_in_tree_order get_attribute get_attribute_locs -defines - get_element_by_id = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_element_by_id first_in_tree_order get_attribute" -and - get_elements_by_class_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name to_tree_order get_attribute" -and - get_elements_by_tag_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_tag_name to_tree_order" . +global_interpretation + l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order first_in_tree_order get_attribute get_attribute_locs + defines + get_element_by_id = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_element_by_id first_in_tree_order get_attribute" + and + get_elements_by_class_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name +to_tree_order get_attribute" + and + get_elements_by_tag_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_tag_name to_tree_order" . locale l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order first_in_tree_order get_attribute get_attribute_locs + @@ -3690,82 +3728,86 @@ locale l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ l_to_tree_order to_tree_order + l_get_attribute type_wf get_attribute get_attribute_locs for to_tree_order :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and first_in_tree_order :: "(_) object_ptr \ ((_) object_ptr \ ((_) heap, exception, (_) element_ptr option) prog) + and first_in_tree_order :: + "(_) object_ptr \ ((_) object_ptr \ ((_) heap, exception, (_) element_ptr option) prog) \ ((_) heap, exception, (_) element_ptr option) prog" - and get_attribute :: "(_) element_ptr \ char list \ ((_) heap, exception, char list option) prog" - and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_element_by_id :: "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr option) prog" - and get_elements_by_class_name :: "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr list) prog" - and get_elements_by_tag_name :: "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr list) prog" - and type_wf :: "(_) heap \ bool" + + and get_attribute :: "(_) element_ptr \ char list \ ((_) heap, exception, char list option) prog" + and get_attribute_locs :: "(_) element_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_element_by_id :: + "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr option) prog" + and get_elements_by_class_name :: + "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr list) prog" + and get_elements_by_tag_name :: + "(_) object_ptr \ char list \ ((_) heap, exception, (_) element_ptr list) prog" + and type_wf :: "(_) heap \ bool" + assumes get_element_by_id_impl: "get_element_by_id = a_get_element_by_id" assumes get_elements_by_class_name_impl: "get_elements_by_class_name = a_get_elements_by_class_name" assumes get_elements_by_tag_name_impl: "get_elements_by_tag_name = a_get_elements_by_tag_name" begin -lemmas +lemmas get_element_by_id_def = get_element_by_id_impl[unfolded a_get_element_by_id_def] -lemmas +lemmas get_elements_by_class_name_def = get_elements_by_class_name_impl[unfolded a_get_elements_by_class_name_def] -lemmas +lemmas get_elements_by_tag_name_def = get_elements_by_tag_name_impl[unfolded a_get_elements_by_tag_name_def] lemma get_element_by_id_result_in_tree_order: assumes "h \ get_element_by_id ptr iden \\<^sub>r Some element_ptr" assumes "h \ to_tree_order ptr \\<^sub>r to" shows "cast element_ptr \ set to" - using assms - by(auto simp add: get_element_by_id_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) + using assms + by(auto simp add: get_element_by_id_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_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) + 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) + 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) h" - by(auto simp add: get_elements_by_tag_name_def - intro!: bind_pure_I map_filter_M_pure - split: option.splits) + by(auto simp add: get_elements_by_tag_name_def + intro!: bind_pure_I map_filter_M_pure + split: option.splits) end locale l_get_element_by = l_get_element_by_defs + l_to_tree_order_defs + - assumes get_element_by_id_result_in_tree_order: - "h \ get_element_by_id ptr iden \\<^sub>r Some element_ptr \ h \ to_tree_order ptr \\<^sub>r to + assumes get_element_by_id_result_in_tree_order: + "h \ get_element_by_id ptr iden \\<^sub>r Some element_ptr \ h \ to_tree_order ptr \\<^sub>r to \ cast element_ptr \ set to" assumes get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag) h" -interpretation - i_get_element_by?: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order first_in_tree_order get_attribute - get_attribute_locs get_element_by_id get_elements_by_class_name - get_elements_by_tag_name type_wf +interpretation + i_get_element_by?: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order first_in_tree_order get_attribute + get_attribute_locs get_element_by_id get_elements_by_class_name + get_elements_by_tag_name type_wf using instances apply(simp add: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def) by(simp add: get_element_by_id_def get_elements_by_class_name_def get_elements_by_tag_name_def) declare l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma get_element_by_is_l_get_element_by [instances]: +lemma get_element_by_is_l_get_element_by [instances]: "l_get_element_by get_element_by_id get_elements_by_tag_name to_tree_order" apply(unfold_locales) using get_element_by_id_result_in_tree_order get_elements_by_tag_name_pure diff --git a/Core_DOM/Core_DOM/common/Core_DOM_Tests.thy b/Core_DOM/Core_DOM/common/Core_DOM_Tests.thy index 3819600..0e7c3ff 100644 --- a/Core_DOM/Core_DOM/common/Core_DOM_Tests.thy +++ b/Core_DOM/Core_DOM/common/Core_DOM_Tests.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/common/classes/BaseClass.thy b/Core_DOM/Core_DOM/common/classes/BaseClass.thy index 011bb9b..6acad53 100644 --- a/Core_DOM/Core_DOM/common/classes/BaseClass.thy +++ b/Core_DOM/Core_DOM/common/classes/BaseClass.thy @@ -23,18 +23,18 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\The Class Infrastructure\ -text\In this theory, we introduce the basic infrastructure for our encoding +text\In this theory, we introduce the basic infrastructure for our encoding of classes.\ theory BaseClass imports "HOL-Library.Finite_Map" "../pointers/Ref" - "../Core_DOM_Basic_Datatypes" + "../Core_DOM_Basic_Datatypes" begin named_theorems instances @@ -43,26 +43,26 @@ consts get :: 'a consts put :: 'a consts delete :: 'a -text \Overall, the definition of the class types follows closely the one of the pointer - types. Instead of datatypes, we use records for our classes. This allows us to, first, +text \Overall, the definition of the class types follows closely the one of the pointer + types. Instead of datatypes, we use records for our classes. This allows us to, first, make use of record inheritance, which is, in addition to the type synonyms of - previous class types, the second place where the inheritance relationship of + previous class types, the second place where the inheritance relationship of our types manifest. Second, we get a convenient notation to define classes, in addition to automatically generated getter and setter functions.\ -text \Along with our class types, we also develop our heap type, which is a finite - map at its core. It is important to note that while the map stores a mapping - from @{term "object_ptr"} to @{term "Object"}, we restrict the type variables - of the record extension slot of @{term "Object"} in such a way that allows - down-casting, but requires a bit of taking-apart and re-assembling of our records +text \Along with our class types, we also develop our heap type, which is a finite + map at its core. It is important to note that while the map stores a mapping + from @{term "object_ptr"} to @{term "Object"}, we restrict the type variables + of the record extension slot of @{term "Object"} in such a way that allows + down-casting, but requires a bit of taking-apart and re-assembling of our records before they are stored in the heap.\ -text \Throughout the theory files, we will use underscore case to reference pointer +text \Throughout the theory files, we will use underscore case to reference pointer types, and camel case for class types.\ -text \Every class type contains at least one attribute; nothing. This is used for - two purposes: first, the record package does not allow records without any - attributes. Second, we will use the getter of nothing later to check whether a +text \Every class type contains at least one attribute; nothing. This is used for + two purposes: first, the record package does not allow records without any + attributes. Second, we will use the getter of nothing later to check whether a class of the correct type could be retrieved, for which we will be able to use our infrastructure regarding the behaviour of getters across different heaps.\ diff --git a/Core_DOM/Core_DOM/common/classes/CharacterDataClass.thy b/Core_DOM/Core_DOM/common/classes/CharacterDataClass.thy index f434a93..73b005f 100644 --- a/Core_DOM/Core_DOM/common/classes/CharacterDataClass.thy +++ b/Core_DOM/Core_DOM/common/classes/CharacterDataClass.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -36,45 +36,45 @@ begin subsubsection\CharacterData\ -text\The type @{type "DOMString"} is a type synonym for @{type "string"}, defined +text\The type @{type "DOMString"} is a type synonym for @{type "string"}, defined \autoref{sec:Core_DOM_Basic_Datatypes}.\ record RCharacterData = RNode + nothing :: unit val :: DOMString -register_default_tvars "'CharacterData RCharacterData_ext" +register_default_tvars "'CharacterData RCharacterData_ext" type_synonym 'CharacterData CharacterData = "'CharacterData option RCharacterData_scheme" -register_default_tvars "'CharacterData CharacterData" -type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, +register_default_tvars "'CharacterData CharacterData" +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element, 'CharacterData) Node - = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, + = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'CharacterData option RCharacterData_ext + 'Node, 'Element) Node" -register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, - 'Element, 'CharacterData) Node" -type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, + 'Element, 'CharacterData) Node" +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData) Object - = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, + = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'CharacterData option RCharacterData_ext + 'Node, 'Element) Object" -register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, - 'Node, 'Element, 'CharacterData) Object" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, + 'Node, 'Element, 'CharacterData) Object" -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData) heap - = "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, + = "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, '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" +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" - where - "character_data_ptr_kinds heap = the |`| (cast |`| (ffilter is_character_data_ptr_kind + where + "character_data_ptr_kinds heap = the |`| (cast |`| (ffilter is_character_data_ptr_kind (node_ptr_kinds heap)))" lemma character_data_ptr_kinds_simp [simp]: - "character_data_ptr_kinds (Heap (fmupd (cast character_data_ptr) character_data (the_heap h))) + "character_data_ptr_kinds (Heap (fmupd (cast character_data_ptr) character_data (the_heap h))) = {|character_data_ptr|} |\| character_data_ptr_kinds h" apply(auto simp add: character_data_ptr_kinds_def)[1] by force @@ -94,7 +94,7 @@ adhoc_overloading cast cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>C\<^su abbreviation cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^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 :: "(_) Object \ (_) CharacterData option" where - "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^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 obj \ (case cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e obj of Some node \ 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 node + "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^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 obj \ (case cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e obj of Some node \ 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 node | None \ None)" adhoc_overloading cast cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^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 @@ -123,15 +123,15 @@ abbreviation is_character_data_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^su adhoc_overloading is_character_data_kind is_character_data_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t lemma character_data_ptr_kinds_commutes [simp]: - "cast character_data_ptr |\| node_ptr_kinds h + "cast character_data_ptr |\| node_ptr_kinds h \ character_data_ptr |\| character_data_ptr_kinds h" apply(auto simp add: character_data_ptr_kinds_def)[1] - by (metis character_data_ptr_casts_commute2 comp_eq_dest_lhs ffmember_filter fimage_eqI + by (metis character_data_ptr_casts_commute2 comp_eq_dest_lhs ffmember_filter fimage_eqI is_character_data_ptr_kind_none option.distinct(1) option.sel) definition 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 \ (_) heap \ (_) CharacterData option" - where + where "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 = Option.bind (get\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast character_data_ptr) h) cast" adhoc_overloading get 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 @@ -160,11 +160,12 @@ sublocale l_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas b lemma 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: assumes "type_wf h" - shows "character_data_ptr |\| character_data_ptr_kinds h + shows "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" 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 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)) + 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 @@ -172,7 +173,7 @@ global_interpretation l_get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^su definition put\<^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 \ (_) CharacterData \ (_) heap \ (_) heap" where - "put\<^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 character_data = put\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast character_data_ptr) + "put\<^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 character_data = put\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast character_data_ptr) (cast character_data)" adhoc_overloading put put\<^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 @@ -196,16 +197,16 @@ lemma cast\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub lemma 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_none [simp]: "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 node = None \ \ (\character_data. cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e character_data = node)" - apply(auto simp add: 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_def cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + apply(auto simp add: 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_def cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits)[1] by (metis (full_types) RNode.select_convs(2) RNode.surjective old.unit.exhaust) -lemma 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_some [simp]: +lemma 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_some [simp]: "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 node = Some character_data \ cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e character_data = node" - by(auto simp add: 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_def cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + by(auto simp add: 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_def cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits) -lemma 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 [simp]: +lemma 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 [simp]: "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 (cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e character_data) = Some character_data" by simp @@ -214,19 +215,19 @@ lemma cast_element_not_character_data [simp]: "(cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e character_data \ cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element)" by(auto simp add: cast\<^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\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RNode.extend_def) -lemma get_CharacterData_simp1 [simp]: - "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 (put\<^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 character_data h) +lemma get_CharacterData_simp1 [simp]: + "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 (put\<^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 character_data h) = Some character_data" by(auto simp add: 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 put\<^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) -lemma get_CharacterData_simp2 [simp]: - "character_data_ptr \ character_data_ptr' \ 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 +lemma get_CharacterData_simp2 [simp]: + "character_data_ptr \ character_data_ptr' \ 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 (put\<^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' character_data 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" by(auto simp add: 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 put\<^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) -lemma get_CharacterData_simp3 [simp]: +lemma get_CharacterData_simp3 [simp]: "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^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 f h) = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^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) -lemma get_CharacterData_simp4 [simp]: +lemma get_CharacterData_simp4 [simp]: "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 element_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t character_data_ptr f 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 element_ptr h" by(auto simp add: 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 put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) @@ -244,7 +245,7 @@ abbreviation "create_character_data_obj val_arg definition new\<^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 :: "(_) heap \ ((_) character_data_ptr \ (_) heap)" where "new\<^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 h = - (let new_character_data_ptr = character_data_ptr.Ref (Suc (fMax (character_data_ptr.the_ref + (let new_character_data_ptr = character_data_ptr.Ref (Suc (fMax (character_data_ptr.the_ref |`| (character_data_ptrs h)))) in (new_character_data_ptr, put new_character_data_ptr (create_character_data_obj '''') h))" @@ -255,17 +256,19 @@ lemma new\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub> unfolding new\<^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 Let_def using put\<^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_ptr_in_heap by blast -lemma new_character_data_ptr_new: - "character_data_ptr.Ref (Suc (fMax (finsert 0 (character_data_ptr.the_ref |`| character_data_ptrs h)))) +lemma new_character_data_ptr_new: + "character_data_ptr.Ref (Suc (fMax (finsert 0 (character_data_ptr.the_ref |`| character_data_ptrs h)))) |\| character_data_ptrs h" - by (metis Suc_n_not_le_n character_data_ptr.sel(1) fMax_ge fimage_finsert finsertI1 finsertI2 set_finsert) + by (metis Suc_n_not_le_n character_data_ptr.sel(1) fMax_ge fimage_finsert finsertI1 + finsertI2 set_finsert) lemma new\<^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_ptr_not_in_heap: assumes "new\<^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 h = (new_character_data_ptr, h')" shows "new_character_data_ptr |\| character_data_ptr_kinds h" using assms unfolding new\<^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 Pair_inject character_data_ptrs_def fMax_finsert fempty_iff ffmember_filter fimage_is_fempty is_character_data_ptr_ref max_0L new_character_data_ptr_new) + by (metis Pair_inject character_data_ptrs_def fMax_finsert fempty_iff ffmember_filter + fimage_is_fempty is_character_data_ptr_ref max_0L new_character_data_ptr_new) lemma new\<^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_new_ptr: assumes "new\<^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 h = (new_character_data_ptr, h')" @@ -313,7 +316,7 @@ definition a_known_ptr :: "(_) object_ptr \ bool" where "a_known_ptr ptr = (known_ptr ptr \ is_character_data_ptr ptr)" -lemma known_ptr_not_character_data_ptr: +lemma known_ptr_not_character_data_ptr: "\is_character_data_ptr ptr \ a_known_ptr ptr \ known_ptr ptr" by(simp add: a_known_ptr_def) end @@ -331,13 +334,15 @@ lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object apply(simp add: a_known_ptrs_def) using notin_fset by fastforce -lemma known_ptrs_preserved: +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: +lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 . diff --git a/Core_DOM/Core_DOM/common/classes/DocumentClass.thy b/Core_DOM/Core_DOM/common/classes/DocumentClass.thy index 094e216..70fdd54 100644 --- a/Core_DOM/Core_DOM/common/classes/DocumentClass.thy +++ b/Core_DOM/Core_DOM/common/classes/DocumentClass.thy @@ -23,18 +23,18 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Document\ text\In this theory, we introduce the types for the Document class.\ theory DocumentClass - imports + imports CharacterDataClass -begin +begin -text\The type @{type "doctype"} is a type synonym for @{type "string"}, defined +text\The type @{type "doctype"} is a type synonym for @{type "string"}, defined in \autoref{sec:Core_DOM_Basic_Datatypes}.\ record ('node_ptr, 'element_ptr, 'character_data_ptr) RDocument = RObject + @@ -42,35 +42,35 @@ record ('node_ptr, 'element_ptr, 'character_data_ptr) RDocument = RObject + doctype :: doctype document_element :: "(_) element_ptr option" disconnected_nodes :: "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr list" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'Document) Document = "('node_ptr, 'element_ptr, 'character_data_ptr, 'Document option) RDocument_scheme" -register_default_tvars +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'Document) Document" -type_synonym - ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, +type_synonym + ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document) Object - = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, + = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, ('node_ptr, 'element_ptr, 'character_data_ptr, 'Document option) RDocument_ext + 'Object, 'Node, 'Element, 'CharacterData) Object" -register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, - 'Object, 'Node, 'Element, 'CharacterData, 'Document) Object" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, + 'Object, 'Node, 'Element, 'CharacterData, 'Document) Object" -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document) heap - = "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, - 'shadow_root_ptr, - ('node_ptr, 'element_ptr, 'character_data_ptr, 'Document option) RDocument_ext + 'Object, 'Node, + = "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, + 'shadow_root_ptr, + ('node_ptr, 'element_ptr, 'character_data_ptr, 'Document option) RDocument_ext + 'Object, 'Node, 'Element, 'CharacterData) heap" -register_default_tvars - "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +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" where - "document_ptr_kinds heap = 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 |`| + "document_ptr_kinds heap = 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 |`| (ffilter is_document_ptr_kind (object_ptr_kinds heap)))" definition document_ptrs :: "(_) heap \ (_) document_ptr fset" @@ -86,7 +86,7 @@ adhoc_overloading cast cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^su definition cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t:: "(_) Document \ (_) Object" where - "cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t document = (RObject.extend (RObject.truncate document) + "cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t document = (RObject.extend (RObject.truncate document) (Inr (Inl (RObject.more document))))" adhoc_overloading cast cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t @@ -94,20 +94,20 @@ definition is_document_kind :: "(_) Object \ bool" where "is_document_kind ptr \ cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr \ None" -lemma document_ptr_kinds_simp [simp]: - "document_ptr_kinds (Heap (fmupd (cast document_ptr) document (the_heap h))) +lemma document_ptr_kinds_simp [simp]: + "document_ptr_kinds (Heap (fmupd (cast document_ptr) document (the_heap h))) = {|document_ptr|} |\| document_ptr_kinds h" apply(auto simp add: document_ptr_kinds_def)[1] by force -lemma document_ptr_kinds_commutes [simp]: +lemma document_ptr_kinds_commutes [simp]: "cast document_ptr |\| object_ptr_kinds h \ document_ptr |\| document_ptr_kinds h" apply(auto simp add: object_ptr_kinds_def document_ptr_kinds_def)[1] - by (metis (no_types, lifting) document_ptr_casts_commute2 document_ptr_document_ptr_cast + by (metis (no_types, lifting) document_ptr_casts_commute2 document_ptr_document_ptr_cast ffmember_filter fimage_eqI fset.map_comp option.sel) definition get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) document_ptr \ (_) heap \ (_) Document option" - where + where "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h = Option.bind (get (cast document_ptr) h) cast" adhoc_overloading get get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t @@ -115,7 +115,7 @@ locale l_type_wf_def\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^s begin definition a_type_wf :: "(_) heap \ bool" where - "a_type_wf h = (CharacterDataClass.type_wf h \ + "a_type_wf h = (CharacterDataClass.type_wf h \ (\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 . @@ -136,7 +136,8 @@ 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 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) + 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 @@ -164,15 +165,15 @@ lemma cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub apply(simp add: cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def) by (metis (full_types) RObject.surjective old.unit.exhaust) -lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none [simp]: +lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none [simp]: "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t obj = None \ \ (\document. cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t document = obj)" - apply(auto simp add: cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def + apply(auto simp add: cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def split: sum.splits)[1] by (metis (full_types) RObject.select_convs(2) RObject.surjective old.unit.exhaust) -lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_some [simp]: +lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_some [simp]: "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t obj = Some document \ cast document = obj" - by(auto simp add: cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def + by(auto simp add: cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def split: sum.splits) lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_inv [simp]: "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t (cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t document) = Some document" @@ -183,24 +184,26 @@ lemma cast_document_not_node [simp]: "cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node \ cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t document" by(auto simp add: cast\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def) -lemma get_document_ptr_simp1 [simp]: +lemma get_document_ptr_simp1 [simp]: "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr document h) = Some document" by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_document_ptr_simp2 [simp]: - "document_ptr \ document_ptr' +lemma get_document_ptr_simp2 [simp]: + "document_ptr \ document_ptr' \ get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr' document h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_document_ptr_simp3 [simp]: +lemma get_document_ptr_simp3 [simp]: "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr f h) = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h" by(auto simp add: 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 put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_document_ptr_simp4 [simp]: "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" +lemma get_document_ptr_simp4 [simp]: + "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def 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) -lemma get_document_ptr_simp5 [simp]: +lemma get_document_ptr_simp5 [simp]: "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 (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr f 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" by(auto simp add: 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 put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_document_ptr_simp6 [simp]: "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^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 f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" +lemma get_document_ptr_simp6 [simp]: + "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^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 f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t [simp]: @@ -217,18 +220,18 @@ lemma new\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub> -abbreviation +abbreviation create_document_obj :: "char list \ (_) element_ptr option \ (_) node_ptr list \ (_) Document" where "create_document_obj doctype_arg document_element_arg disconnected_nodes_arg - \ \ RObject.nothing = (), RDocument.nothing = (), doctype = doctype_arg, + \ \ RObject.nothing = (), RDocument.nothing = (), doctype = doctype_arg, document_element = document_element_arg, disconnected_nodes = disconnected_nodes_arg, \ = None \" 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 (finsert 0 (document_ptr.the_ref |`| (document_ptrs h))))) + "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 (finsert 0 (document_ptr.the_ref |`| (document_ptrs h))))) in (new_document_ptr, put new_document_ptr (create_document_obj '''' None []) h))" @@ -239,8 +242,8 @@ lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in unfolding new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def using put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap by blast -lemma new_document_ptr_new: - "document_ptr.Ref (Suc (fMax (finsert 0 (document_ptr.the_ref |`| document_ptrs h)))) +lemma new_document_ptr_new: + "document_ptr.Ref (Suc (fMax (finsert 0 (document_ptr.the_ref |`| document_ptrs h)))) |\| document_ptrs h" by (metis Suc_n_not_le_n document_ptr.sel(1) fMax_ge fimage_finsert finsertI1 finsertI2 set_finsert) @@ -249,7 +252,7 @@ lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_no shows "new_document_ptr |\| document_ptr_kinds h" using assms unfolding new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - by (metis Pair_inject document_ptrs_def fMax_finsert fempty_iff ffmember_filter + by (metis Pair_inject document_ptrs_def fMax_finsert fempty_iff ffmember_filter fimage_is_fempty is_document_ptr_ref max_0L new_document_ptr_new) lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_new_ptr: @@ -321,13 +324,15 @@ lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object apply(simp add: a_known_ptrs_def) using notin_fset by fastforce -lemma known_ptrs_preserved: +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: +lemma known_ptrs_subset: "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 . diff --git a/Core_DOM/Core_DOM/common/classes/NodeClass.thy b/Core_DOM/Core_DOM/common/classes/NodeClass.thy index fdbbff1..2925bd7 100644 --- a/Core_DOM/Core_DOM/common/classes/NodeClass.thy +++ b/Core_DOM/Core_DOM/common/classes/NodeClass.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -41,33 +41,33 @@ subsubsection\Node\ record RNode = RObject + nothing :: unit -register_default_tvars "'Node RNode_ext" +register_default_tvars "'Node RNode_ext" type_synonym 'Node Node = "'Node RNode_scheme" -register_default_tvars "'Node Node" +register_default_tvars "'Node Node" type_synonym ('Object, 'Node) Object = "('Node RNode_ext + 'Object) Object" -register_default_tvars "('Object, 'Node) Object" +register_default_tvars "('Object, 'Node) Object" 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" + "('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" where - "node_ptr_kinds heap = + "node_ptr_kinds heap = (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 |`| (ffilter is_node_ptr_kind (object_ptr_kinds heap))))" -lemma node_ptr_kinds_simp [simp]: - "node_ptr_kinds (Heap (fmupd (cast node_ptr) node (the_heap h))) +lemma node_ptr_kinds_simp [simp]: + "node_ptr_kinds (Heap (fmupd (cast node_ptr) node (the_heap h))) = {|node_ptr|} |\| node_ptr_kinds h" apply(auto simp add: node_ptr_kinds_def)[1] by force definition cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e :: "(_) Object \ (_) Node option" where - "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e obj = (case RObject.more obj of Inl node + "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e obj = (case RObject.more obj of Inl node \ Some (RObject.extend (RObject.truncate obj) node) | _ \ None)" adhoc_overloading cast cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e @@ -81,7 +81,7 @@ definition is_node_kind :: "(_) Object \ bool" "is_node_kind ptr \ cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr \ None" definition get\<^sub>N\<^sub>o\<^sub>d\<^sub>e :: "(_) node_ptr \ (_) heap \ (_) Node option" - where + where "get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h = Option.bind (get (cast node_ptr) h) cast" adhoc_overloading get get\<^sub>N\<^sub>o\<^sub>d\<^sub>e @@ -89,7 +89,7 @@ locale l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e begin definition a_type_wf :: "(_) heap \ bool" where - "a_type_wf h = (ObjectClass.type_wf h + "a_type_wf h = (ObjectClass.type_wf h \ (\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 . @@ -110,8 +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 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)) + 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 @@ -127,7 +127,7 @@ lemma put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ptr_in_heap: shows "node_ptr |\| node_ptr_kinds h'" using assms unfolding put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def node_ptr_kinds_def - by (metis ffmember_filter fimage_eqI is_node_ptr_kind_cast node_ptr_casts_commute2 + by (metis ffmember_filter fimage_eqI is_node_ptr_kind_cast node_ptr_casts_commute2 option.sel put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap) lemma put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_put_ptrs: @@ -136,14 +136,14 @@ lemma put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_put_ptrs: using assms by (simp add: put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_put_ptrs) -lemma node_ptr_kinds_commutes [simp]: +lemma node_ptr_kinds_commutes [simp]: "cast node_ptr |\| object_ptr_kinds h \ node_ptr |\| node_ptr_kinds h" apply(auto simp add: node_ptr_kinds_def split: option.splits)[1] - by (metis (no_types, lifting) ffmember_filter fimage_eqI fset.map_comp + by (metis (no_types, lifting) ffmember_filter fimage_eqI fset.map_comp is_node_ptr_kind_none node_ptr_casts_commute2 option.distinct(1) option.sel) -lemma node_empty [simp]: +lemma node_empty [simp]: "\RObject.nothing = (), RNode.nothing = (), \ = RNode.more node\ = node" by simp @@ -151,7 +151,7 @@ lemma cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub apply(simp add: cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def) by (metis (full_types) RObject.surjective old.unit.exhaust) -lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none [simp]: +lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none [simp]: "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e obj = None \ \ (\node. cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node = obj)" apply(auto simp add: cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def RObject.extend_def split: sum.splits)[1] by (metis (full_types) RObject.select_convs(2) RObject.surjective old.unit.exhaust) @@ -181,23 +181,28 @@ definition a_known_ptrs :: "(_) heap \ bool" lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" 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'" +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'" +lemma known_ptrs_subset: + "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 known_ptrs_new_ptr + 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) -lemma get_node_ptr_simp2 [simp]: +lemma get_node_ptr_simp2 [simp]: "node_ptr \ node_ptr' \ get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr (put\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr' node h) = get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h" 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/Core_DOM/common/classes/ObjectClass.thy b/Core_DOM/Core_DOM/common/classes/ObjectClass.thy index 7461138..dc099ab 100644 --- a/Core_DOM/Core_DOM/common/classes/ObjectClass.thy +++ b/Core_DOM/Core_DOM/common/classes/ObjectClass.thy @@ -23,12 +23,12 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Object\ -text\In this theory, we introduce the definition of the class Object. This class is the +text\In this theory, we introduce the definition of the class Object. This class is the common superclass of our class model.\ theory ObjectClass @@ -39,27 +39,27 @@ begin record RObject = nothing :: unit -register_default_tvars "'Object RObject_ext" +register_default_tvars "'Object RObject_ext" type_synonym 'Object Object = "'Object RObject_scheme" -register_default_tvars "'Object Object" +register_default_tvars "'Object Object" datatype ('object_ptr, 'Object) heap = Heap (the_heap: "((_) object_ptr, (_) Object) fmap") -register_default_tvars "('object_ptr, 'Object) heap" +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 "object_ptr_kinds = fmdom \ the_heap" -lemma object_ptr_kinds_simp [simp]: - "object_ptr_kinds (Heap (fmupd object_ptr object (the_heap h))) +lemma object_ptr_kinds_simp [simp]: + "object_ptr_kinds (Heap (fmupd object_ptr object (the_heap h))) = {|object_ptr|} |\| object_ptr_kinds h" by(auto simp add: object_ptr_kinds_def) definition get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "(_) object_ptr \ (_) heap \ (_) Object option" where "get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = fmlookup (the_heap h) ptr" -adhoc_overloading get get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t +adhoc_overloading get get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t locale l_type_wf_def\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t begin @@ -102,7 +102,7 @@ lemma put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_put_ptrs: assumes "put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr object h = h'" shows "object_ptr_kinds h' = object_ptr_kinds h |\| {|object_ptr|}" using assms - by (metis comp_apply fmdom_fmupd funion_finsert_right heap.sel object_ptr_kinds_def + by (metis comp_apply fmdom_fmupd funion_finsert_right heap.sel object_ptr_kinds_def sup_bot.right_neutral put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def) lemma object_more_extend_id [simp]: "more (extend x y) = y" @@ -117,7 +117,7 @@ definition a_known_ptr :: "(_) object_ptr \ bool" where "a_known_ptr ptr = False" -lemma known_ptr_not_object_ptr: +lemma known_ptr_not_object_ptr: "a_known_ptr ptr \ \is_object_ptr ptr \ known_ptr ptr" by(simp add: a_known_ptr_def) end @@ -127,9 +127,13 @@ lemmas known_ptr_defs = a_known_ptr_def locale l_known_ptrs = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \ bool" + fixes known_ptrs :: "(_) heap \ bool" assumes known_ptrs_known_ptr: "known_ptrs h \ 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'" + 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 @@ -137,16 +141,20 @@ definition a_known_ptrs :: "(_) heap \ bool" where "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" -lemma known_ptrs_known_ptr: +lemma known_ptrs_known_ptr: "a_known_ptrs h \ ptr |\| object_ptr_kinds h \ known_ptr ptr" 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'" +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'" +lemma known_ptrs_subset: + "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 . @@ -159,8 +167,8 @@ lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs" 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" by(simp add: get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def) -lemma get_object_ptr_simp2 [simp]: - "object_ptr \ object_ptr' +lemma get_object_ptr_simp2 [simp]: + "object_ptr \ object_ptr' \ 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) = get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr h" by(simp add: get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def) @@ -169,11 +177,11 @@ subsection\Limited Heap Modifications\ definition heap_unchanged_except :: "(_) object_ptr set \ (_) heap \ (_) heap \ bool" where - "heap_unchanged_except S h h' = (\ptr \ (fset (object_ptr_kinds h) + "heap_unchanged_except S h h' = (\ptr \ (fset (object_ptr_kinds h) \ (fset (object_ptr_kinds h'))) - S. get ptr h = get ptr h')" definition delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "(_) object_ptr \ (_) heap \ (_) heap option" where - "delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = (if ptr |\| object_ptr_kinds h then Some (Heap (fmdrop ptr (the_heap h))) + "delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = (if ptr |\| object_ptr_kinds h then Some (Heap (fmdrop ptr (the_heap h))) else None)" lemma delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_pointer_removed: @@ -201,15 +209,15 @@ definition "create_heap xs = Heap (fmap_of_list xs)" code_datatype ObjectClass.heap.Heap create_heap -lemma object_ptr_kinds_code3 [code]: +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]: +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]: +lemma object_ptr_kinds_code5 [code]: "the_heap (Heap x) = x" by simp diff --git a/Core_DOM/Core_DOM/common/monads/BaseMonad.thy b/Core_DOM/Core_DOM/common/monads/BaseMonad.thy index 46ada40..942e751 100644 --- a/Core_DOM/Core_DOM/common/monads/BaseMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/BaseMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -46,7 +46,7 @@ consts put_M :: 'a consts get_M :: 'a consts delete_M :: 'a -lemma sorted_list_of_set_eq [dest]: +lemma sorted_list_of_set_eq [dest]: "sorted_list_of_set (fset x) = sorted_list_of_set (fset y) \ x = y" by (metis finite_fset fset_inject sorted_list_of_set(1)) @@ -70,18 +70,18 @@ lemma ptr_kinds_M_pure [simp]: "pure a_ptr_kinds_M h" lemma ptr_kinds_ptr_kinds_M [simp]: "ptr \ set |h \ a_ptr_kinds_M|\<^sub>r \ ptr |\| ptr_kinds h" by(simp add: a_ptr_kinds_M_def) -lemma ptr_kinds_M_ptr_kinds [simp]: +lemma ptr_kinds_M_ptr_kinds [simp]: "h \ a_ptr_kinds_M \\<^sub>r xa \ xa = sorted_list_of_set (fset (ptr_kinds h))" by(auto simp add: a_ptr_kinds_M_def) -lemma ptr_kinds_M_ptr_kinds_returns_result [simp]: +lemma ptr_kinds_M_ptr_kinds_returns_result [simp]: "h \ a_ptr_kinds_M \ f \\<^sub>r x \ h \ f (sorted_list_of_set (fset (ptr_kinds h))) \\<^sub>r x" by(auto simp add: a_ptr_kinds_M_def) -lemma ptr_kinds_M_ptr_kinds_returns_heap [simp]: +lemma ptr_kinds_M_ptr_kinds_returns_heap [simp]: "h \ a_ptr_kinds_M \ f \\<^sub>h h' \ h \ f (sorted_list_of_set (fset (ptr_kinds h))) \\<^sub>h h'" by(auto simp add: a_ptr_kinds_M_def) end -locale l_get_M = +locale l_get_M = fixes get :: "'ptr \ 'heap \ 'obj option" fixes type_wf :: "'heap \ bool" fixes ptr_kinds :: "'heap \ 'ptr fset" @@ -129,14 +129,14 @@ lemma put_M_ok: lemma put_M_ptr_in_heap: "h \ ok (a_put_M ptr setter v) \ ptr |\| ptr_kinds h" - by(auto simp add: a_put_M_def intro!: bind_is_OK_I2 elim: get_M_ptr_in_heap + by(auto simp add: a_put_M_def intro!: bind_is_OK_I2 elim: get_M_ptr_in_heap dest: is_OK_returns_result_I elim!: bind_is_OK_E) end subsection \Setup for Defining Partial Functions\ -lemma execute_admissible: +lemma execute_admissible: "ccpo.admissible (fun_lub (flat_lub (Inl (e::'e)))) (fun_ord (flat_ord (Inl e))) ((\a. \(h::'heap) h2 (r::'result). h \ a = Inr (r, h2) \ P h h2 r) \ Prog)" proof (unfold comp_def, rule ccpo.admissibleI, clarify) @@ -153,16 +153,16 @@ proof (unfold comp_def, rule ccpo.admissibleI, clarify) by force qed -lemma execute_admissible2: +lemma execute_admissible2: "ccpo.admissible (fun_lub (flat_lub (Inl (e::'e)))) (fun_ord (flat_ord (Inl e))) - ((\a. \(h::'heap) h' h2 h2' (r::'result) r'. + ((\a. \(h::'heap) h' h2 h2' (r::'result) r'. h \ a = Inr (r, h2) \ h' \ a = Inr (r', h2') \ P h h' h2 h2' r r') \ Prog)" proof (unfold comp_def, rule ccpo.admissibleI, clarify) fix A :: "('heap \ 'e + 'result \ 'heap) set" let ?lub = "Prog (fun_lub (flat_lub (Inl e)) A)" fix h h' h2 h2' r r' assume 1: "Complete_Partial_Order.chain (fun_ord (flat_ord (Inl e))) A" - and 2 [rule_format]: "\xa\A. \h h' h2 h2' r r'. h \ Prog xa = Inr (r, h2) + and 2 [rule_format]: "\xa\A. \h h' h2 h2' r r'. h \ Prog xa = Inr (r, h2) \ h' \ Prog xa = Inr (r', h2') \ P h h' h2 h2' r r'" and 4: "h \ Prog (fun_lub (flat_lub (Inl e)) A) = Inr (r, h2)" and 5: "h' \ Prog (fun_lub (flat_lub (Inl e)) A) = Inr (r', h2')" @@ -180,18 +180,18 @@ proof (unfold comp_def, rule ccpo.admissibleI, clarify) "f \ A" and "h \ Prog f = Inr (r, h2)" and "h' \ Prog f = Inr (r', h2')" - using 1 4 5 + using 1 4 5 apply(auto simp add: chain_def fun_ord_def flat_ord_def execute_def)[1] by (metis Inl_Inr_False) then show "P h h' h2 h2' r r'" by(fact 2) qed -definition dom_prog_ord :: +definition dom_prog_ord :: "('heap, exception, 'result) prog \ ('heap, exception, 'result) prog \ bool" where "dom_prog_ord = img_ord (\a b. execute b a) (fun_ord (flat_ord (Inl NonTerminationException)))" -definition dom_prog_lub :: +definition dom_prog_lub :: "('heap, exception, 'result) prog set \ ('heap, exception, 'result) prog" where "dom_prog_lub = img_lub (\a b. execute b a) Prog (fun_lub (flat_lub (Inl NonTerminationException)))" @@ -200,7 +200,7 @@ lemma dom_prog_lub_empty: "dom_prog_lub {} = error NonTerminationException" lemma dom_prog_interpretation: "partial_function_definitions dom_prog_ord dom_prog_lub" proof - - have "partial_function_definitions (fun_ord (flat_ord (Inl NonTerminationException))) + have "partial_function_definitions (fun_ord (flat_ord (Inl NonTerminationException))) (fun_lub (flat_lub (Inl NonTerminationException)))" by (rule partial_function_lift) (rule flat_interpretation) then show ?thesis @@ -212,15 +212,15 @@ interpretation dom_prog: partial_function_definitions dom_prog_ord dom_prog_lub rewrites "dom_prog_lub {} \ error NonTerminationException" by (fact dom_prog_interpretation)(simp add: dom_prog_lub_empty) -lemma admissible_dom_prog: +lemma admissible_dom_prog: "dom_prog.admissible (\f. \x h h' r. h \ f x \\<^sub>r r \ h \ f x \\<^sub>h h' \ P x h h' r)" proof (rule admissible_fun[OF dom_prog_interpretation]) fix x - show "ccpo.admissible dom_prog_lub dom_prog_ord (\a. \h h' r. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' + show "ccpo.admissible dom_prog_lub dom_prog_ord (\a. \h h' r. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' \ P x h h' r)" unfolding dom_prog_ord_def dom_prog_lub_def proof (intro admissible_image partial_function_lift flat_interpretation) - show "ccpo.admissible (fun_lub (flat_lub (Inl NonTerminationException))) + show "ccpo.admissible (fun_lub (flat_lub (Inl NonTerminationException))) (fun_ord (flat_ord (Inl NonTerminationException))) ((\a. \h h' r. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' \ P x h h' r) \ Prog)" by(auto simp add: execute_admissible returns_result_def returns_heap_def split: sum.splits) @@ -234,20 +234,20 @@ proof (rule admissible_fun[OF dom_prog_interpretation]) qed lemma admissible_dom_prog2: - "dom_prog.admissible (\f. \x h h2 h' h2' r r2. h \ f x \\<^sub>r r \ h \ f x \\<^sub>h h' + "dom_prog.admissible (\f. \x h h2 h' h2' r r2. h \ f x \\<^sub>r r \ h \ f x \\<^sub>h h' \ h2 \ f x \\<^sub>r r2 \ h2 \ f x \\<^sub>h h2' \ P x h h2 h' h2' r r2)" proof (rule admissible_fun[OF dom_prog_interpretation]) fix x - show "ccpo.admissible dom_prog_lub dom_prog_ord (\a. \h h2 h' h2' r r2. h \ a \\<^sub>r r + show "ccpo.admissible dom_prog_lub dom_prog_ord (\a. \h h2 h' h2' r r2. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' \ h2 \ a \\<^sub>r r2 \ h2 \ a \\<^sub>h h2' \ P x h h2 h' h2' r r2)" unfolding dom_prog_ord_def dom_prog_lub_def proof (intro admissible_image partial_function_lift flat_interpretation) - show "ccpo.admissible (fun_lub (flat_lub (Inl NonTerminationException))) + show "ccpo.admissible (fun_lub (flat_lub (Inl NonTerminationException))) (fun_ord (flat_ord (Inl NonTerminationException))) - ((\a. \h h2 h' h2' r r2. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' \ h2 \ a \\<^sub>r r2 \ h2 \ a \\<^sub>h h2' + ((\a. \h h2 h' h2' r r2. h \ a \\<^sub>r r \ h \ a \\<^sub>h h' \ h2 \ a \\<^sub>r r2 \ h2 \ a \\<^sub>h h2' \ P x h h2 h' h2' r r2) \ Prog)" - by(auto simp add: returns_result_def returns_heap_def intro!: ccpo.admissibleI - dest!: ccpo.admissibleD[OF execute_admissible2[where P="P x"]] + by(auto simp add: returns_result_def returns_heap_def intro!: ccpo.admissibleI + dest!: ccpo.admissibleD[OF execute_admissible2[where P="P x"]] split: sum.splits) next show "\x y. (\b. b \ x) = (\b. b \ y) \ x = y" @@ -266,7 +266,7 @@ lemma fixp_induct_dom_prog: assumes mono: "\x. monotone (fun_ord dom_prog_ord) dom_prog_ord (\f. U (F (C f)) x)" assumes eq: "f \ C (ccpo.fixp (fun_lub dom_prog_lub) (fun_ord dom_prog_ord) (\f. U (F (C f))))" assumes inverse2: "\f. U (C f) = f" - assumes step: "\f x h h' r. (\x h h' r. h \ (U f x) \\<^sub>r r \ h \ (U f x) \\<^sub>h h' \ P x h h' r) + assumes step: "\f x h h' r. (\x h h' r. h \ (U f x) \\<^sub>r r \ h \ (U f x) \\<^sub>h h' \ P x h h' r) \ h \ (U (F f) x) \\<^sub>r r \ h \ (U (F f) x) \\<^sub>h h' \ P x h h' r" assumes defined: "h \ (U f x) \\<^sub>r r" and "h \ (U f x) \\<^sub>h h'" shows "P x h h' r" @@ -315,7 +315,7 @@ proof (rule monotoneI) proof (rule dom_prog_ordI) fix h from 1 show "h \ ?L \\<^sub>e NonTerminationException \ h \ ?L = h \ ?R" - apply(rule dom_prog_ordE) + apply(rule dom_prog_ordE) apply(auto)[1] using bind_cong by fastforce qed @@ -358,7 +358,7 @@ lemma mono_dom_prog1 [partial_function_mono]: assumes "\x. (mono_dom_prog (\f. g f x))" shows "mono_dom_prog (\f. map_M (g f) xs)" using assms - apply (induct xs) + apply (induct xs) by(auto simp add: call_mono dom_prog.const_mono intro!: bind_mono) lemma mono_dom_prog2 [partial_function_mono]: @@ -366,10 +366,10 @@ lemma mono_dom_prog2 [partial_function_mono]: assumes "\x. (mono_dom_prog (\f. g f x))" shows "mono_dom_prog (\f. forall_M (g f) xs)" using assms - apply (induct xs) + apply (induct xs) by(auto simp add: call_mono dom_prog.const_mono intro!: bind_mono) -lemma sorted_list_set_cong [simp]: +lemma sorted_list_set_cong [simp]: "sorted_list_of_set (fset FS) = sorted_list_of_set (fset FS') \ FS = FS'" by auto diff --git a/Core_DOM/Core_DOM/common/monads/CharacterDataMonad.thy b/Core_DOM/Core_DOM/common/monads/CharacterDataMonad.thy index 6eff901..6458673 100644 --- a/Core_DOM/Core_DOM/common/monads/CharacterDataMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/CharacterDataMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -35,36 +35,36 @@ theory CharacterDataMonad "../classes/CharacterDataClass" begin -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'result) dom_prog = "((_) heap, exception, 'result) prog" -register_default_tvars - "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, - 'Object, 'Node, 'Element, 'CharacterData, 'result) dom_prog" +register_default_tvars + "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, + 'Object, 'Node, 'Element, 'CharacterData, 'result) dom_prog" -global_interpretation l_ptr_kinds_M character_data_ptr_kinds +global_interpretation l_ptr_kinds_M character_data_ptr_kinds defines character_data_ptr_kinds_M = a_ptr_kinds_M . lemmas character_data_ptr_kinds_M_defs = a_ptr_kinds_M_def lemma character_data_ptr_kinds_M_eq: assumes "|h \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" shows "|h \ character_data_ptr_kinds_M|\<^sub>r = |h' \ character_data_ptr_kinds_M|\<^sub>r" - using assms - by(auto simp add: character_data_ptr_kinds_M_defs node_ptr_kinds_M_defs + using assms + by(auto simp add: character_data_ptr_kinds_M_defs node_ptr_kinds_M_defs character_data_ptr_kinds_def) -lemma character_data_ptr_kinds_M_reads: +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 + apply (simp add: reads_def node_ptr_kinds_M_defs character_data_ptr_kinds_M_defs 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" apply(simp add: 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 l_get_M_def) - by (metis (no_types, hide_lams) NodeMonad.get_M_is_l_get_M bind_eq_Some_conv + by (metis (no_types, hide_lams) NodeMonad.get_M_is_l_get_M bind_eq_Some_conv character_data_ptr_kinds_commutes 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_get_M_def option.distinct(1)) lemmas get_M_defs = 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_def[unfolded l_get_M.a_get_M_def[OF get_M_is_l_get_M]] @@ -84,7 +84,7 @@ end global_interpretation l_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_lemmas type_wf by unfold_locales -global_interpretation l_put_M type_wf character_data_ptr_kinds 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 put\<^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 +global_interpretation l_put_M type_wf character_data_ptr_kinds 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 put\<^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 rewrites "a_get_M = 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" defines put_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 = a_put_M apply (simp add: get_M_is_l_get_M l_put_M_def) by (simp add: 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_def) @@ -109,98 +109,98 @@ global_interpretation l_put_M\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^ -lemma CharacterData_simp1 [simp]: - "(\x. getter (setter (\_. v) x) = v) \ h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp1 [simp]: + "(\x. getter (setter (\_. v) x) = v) \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ h' \ 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 character_data_ptr getter \\<^sub>r v" by(auto simp add: put_M_defs get_M_defs split: option.splits) -lemma CharacterData_simp2 [simp]: - "character_data_ptr \ character_data_ptr' - \ h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp2 [simp]: + "character_data_ptr \ character_data_ptr' + \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr' getter) h h'" by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) lemma CharacterData_simp3 [simp]: " - (\x. getter (setter (\_. v) x) = getter x) - \ h \ put_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 character_data_ptr setter v \\<^sub>h h' + (\x. getter (setter (\_. v) x) = getter x) + \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr' getter) h h'" - apply(cases "character_data_ptr = character_data_ptr'") + apply(cases "character_data_ptr = character_data_ptr'") by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma CharacterData_simp4 [simp]: - "h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp4 [simp]: + "h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter) h h'" - by(auto simp add: put_M_defs ElementMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs ElementMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma CharacterData_simp5 [simp]: - "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' +lemma CharacterData_simp5 [simp]: + "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr getter) h h'" - by(auto simp add: ElementMonad.put_M_defs get_M_defs preserved_def + by(auto simp add: ElementMonad.put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma CharacterData_simp6 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma CharacterData_simp6 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - apply (cases "cast character_data_ptr = object_ptr") - by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + apply (cases "cast character_data_ptr = object_ptr") + by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def bind_eq_Some_conv split: option.splits) -lemma CharacterData_simp7 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) - \ h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp7 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) + \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" apply(cases "cast character_data_ptr = node_ptr") - by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def bind_eq_Some_conv split: option.splits) -lemma CharacterData_simp8 [simp]: - "cast character_data_ptr \ node_ptr - \ h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp8 [simp]: + "cast character_data_ptr \ node_ptr + \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_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 put\<^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 NodeMonad.get_M_defs + by(auto simp add: put_M_defs get_M_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 put\<^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 NodeMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma CharacterData_simp9 [simp]: - "h \ put_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 character_data_ptr setter v \\<^sub>h h' - \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma CharacterData_simp9 [simp]: + "h \ put_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 character_data_ptr setter v \\<^sub>h h' + \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" apply(cases "cast character_data_ptr \ node_ptr") - by(auto simp add: put_M_defs get_M_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 put\<^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 - NodeMonad.get_M_defs preserved_def split: option.splits bind_splits + by(auto simp add: put_M_defs get_M_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 put\<^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 + NodeMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E) -lemma CharacterData_simp10 [simp]: - "cast character_data_ptr \ node_ptr - \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' +lemma CharacterData_simp10 [simp]: + "cast character_data_ptr \ node_ptr + \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr getter) h h'" - by(auto simp add: NodeMonad.put_M_defs get_M_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 NodeMonad.get_M_defs + by(auto simp add: NodeMonad.put_M_defs get_M_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 NodeMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma CharacterData_simp11 [simp]: - "cast character_data_ptr \ object_ptr - \ h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma CharacterData_simp11 [simp]: + "cast character_data_ptr \ object_ptr + \ h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^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 - ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^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 + ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) lemma CharacterData_simp12 [simp]: - "h \ put_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 character_data_ptr setter v \\<^sub>h h' - \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) + "h \ put_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 character_data_ptr setter v \\<^sub>h h' + \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" apply(cases "cast character_data_ptr \ object_ptr") - apply(auto simp add: put_M_defs get_M_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 put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def + apply(auto simp add: put_M_defs get_M_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 put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E)[1] - by(auto simp add: put_M_defs get_M_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 put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_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 put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E)[1] -lemma CharacterData_simp13 [simp]: - "cast character_data_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' +lemma CharacterData_simp13 [simp]: + "cast character_data_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr getter) h h'" - by(auto simp add: ObjectMonad.put_M_defs get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + by(auto simp add: ObjectMonad.put_M_defs get_M_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 get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma new_element_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: +lemma new_element_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: "h \ new_element \\<^sub>h h' \ preserved (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 ptr getter) h h'" - by(auto simp add: new_element_def get_M_defs preserved_def split: prod.splits option.splits + by(auto simp add: new_element_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) @@ -225,7 +225,7 @@ lemma new_character_data_ptr_in_heap: shows "new_character_data_ptr |\| character_data_ptr_kinds h'" using assms unfolding new_character_data_def - by(auto simp add: new_character_data_def new\<^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 Let_def put\<^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_ptr_in_heap + by(auto simp add: new_character_data_def new\<^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 Let_def put\<^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_ptr_in_heap is_OK_returns_result_I elim!: bind_returns_result_E bind_returns_heap_E) @@ -234,7 +234,7 @@ lemma new_character_data_ptr_not_in_heap: and "h \ new_character_data \\<^sub>r new_character_data_ptr" shows "new_character_data_ptr |\| character_data_ptr_kinds h" using assms new\<^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_ptr_not_in_heap - by(auto simp add: new_character_data_def split: prod.splits + by(auto simp add: new_character_data_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_character_data_new_ptr: @@ -242,7 +242,7 @@ lemma new_character_data_new_ptr: and "h \ new_character_data \\<^sub>r new_character_data_ptr" shows "object_ptr_kinds h' = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" using assms new\<^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_new_ptr - by(auto simp add: new_character_data_def split: prod.splits + by(auto simp add: new_character_data_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_character_data_is_character_data_ptr: @@ -256,41 +256,41 @@ lemma new_character_data_child_nodes: assumes "h \ new_character_data \\<^sub>r new_character_data_ptr" shows "h' \ get_M new_character_data_ptr val \\<^sub>r ''''" using assms - by(auto simp add: get_M_defs new_character_data_def new\<^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 Let_def + by(auto simp add: get_M_defs new_character_data_def new\<^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 Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_character_data_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: - "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr +lemma new_character_data_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: + "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr \ ptr \ cast new_character_data_ptr \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr getter) h h'" - by(auto simp add: new_character_data_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: new_character_data_def ObjectMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_character_data_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: - "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr +lemma new_character_data_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: + "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr \ ptr \ cast new_character_data_ptr \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr getter) h h'" - by(auto simp add: new_character_data_def NodeMonad.get_M_defs preserved_def + by(auto simp add: new_character_data_def NodeMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: - "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr +lemma new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: + "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" - by(auto simp add: new_character_data_def ElementMonad.get_M_defs preserved_def + by(auto simp add: new_character_data_def ElementMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_character_data_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: - "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr +lemma new_character_data_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: + "h \ new_character_data \\<^sub>h h' \ h \ new_character_data \\<^sub>r new_character_data_ptr \ ptr \ new_character_data_ptr \ preserved (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 ptr getter) h h'" - by(auto simp add: new_character_data_def get_M_defs preserved_def + by(auto simp add: new_character_data_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) subsection\Modified Heaps\ -lemma get_CharacterData_ptr_simp [simp]: - "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 (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma get_CharacterData_ptr_simp [simp]: + "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 (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = (if ptr = cast character_data_ptr then cast obj else get character_data_ptr h)" by(auto simp add: 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 split: option.splits Option.bind_splits) -lemma Character_data_ptr_kinds_simp [simp]: - "character_data_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = character_data_ptr_kinds h |\| +lemma Character_data_ptr_kinds_simp [simp]: + "character_data_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = character_data_ptr_kinds h |\| (if is_character_data_ptr_kind ptr then {|the (cast ptr)|} else {||})" by(auto simp add: character_data_ptr_kinds_def is_node_ptr_kind_def split: option.splits) @@ -307,7 +307,7 @@ lemma type_wf_put_ptr_not_in_heap_E: assumes "ptr |\| object_ptr_kinds h" shows "type_wf h" using assms - apply(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)[1] using assms(2) node_ptr_kinds_commutes by blast @@ -319,7 +319,8 @@ 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] - 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) + 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\ @@ -327,13 +328,13 @@ lemma new_element_type_wf_preserved [simp]: assumes "h \ new_element \\<^sub>h h'" shows "type_wf h = type_wf h'" using assms - apply(auto simp add: new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def 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 - elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E + apply(auto simp add: new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def 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 + elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E intro!: type_wf_put_I split: if_splits)[1] using CharacterDataClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t assms new_element_type_wf_preserved apply blast using element_ptrs_def apply fastforce using CharacterDataClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t assms new_element_type_wf_preserved apply blast - by (metis Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def fMax_ge ffmember_filter + by (metis Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def fMax_ge ffmember_filter fimage_eqI is_element_ptr_ref) lemma new_element_is_l_new_element: "l_new_element type_wf" @@ -342,20 +343,20 @@ lemma new_element_is_l_new_element: "l_new_element type_wf" lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: "h \ put_M element_ptr tag_name_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: ElementMonad.put_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 - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I + apply(auto simp add: ElementMonad.put_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 + dest!: get_heap_E + elim!: bind_returns_heap_E2 + intro!: 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 + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs + 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 (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) @@ -363,70 +364,70 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_typ done -lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]: +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'" - apply(auto simp add: ElementMonad.put_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 - dest!: get_heap_E elim!: bind_returns_heap_E2 - intro!: type_wf_put_I ElementMonad.type_wf_put_I + apply(auto simp add: ElementMonad.put_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 + dest!: get_heap_E elim!: bind_returns_heap_E2 + intro!: 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 + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs + 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 (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]: +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'" - apply(auto simp add: ElementMonad.put_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 - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I + apply(auto simp add: ElementMonad.put_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 + dest!: get_heap_E + elim!: bind_returns_heap_E2 + intro!: 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 + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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 (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]: +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'" - apply(auto simp add: ElementMonad.put_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 - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I + apply(auto simp add: ElementMonad.put_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 + dest!: get_heap_E + elim!: bind_returns_heap_E2 + intro!: 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 + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs + 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 (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) @@ -434,11 +435,11 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ done -lemma new_character_data_type_wf_preserved [simp]: +lemma new_character_data_type_wf_preserved [simp]: "h \ new_character_data \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: new_character_data_def new\<^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 Let_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def - elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E - intro!: type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I ObjectMonad.type_wf_put_I + apply(auto simp add: new_character_data_def new\<^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 Let_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E + intro!: type_wf_put_I ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I ObjectMonad.type_wf_put_I split: if_splits)[1] apply(simp_all add: type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs is_node_kind_def) by (meson new\<^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 new\<^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_ptr_not_in_heap) @@ -450,36 +451,36 @@ lemma new_character_data_is_l_new_character_data: "l_new_character_data type_wf" using l_new_character_data.intro new_character_data_type_wf_preserved by blast -lemma put_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_val_type_wf_preserved [simp]: +lemma put_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_val_type_wf_preserved [simp]: "h \ put_M character_data_ptr val_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: CharacterDataMonad.put_M_defs put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + apply(auto simp add: CharacterDataMonad.put_M_defs put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def CharacterDataClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e CharacterDataClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: 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 CharacterDataMonad.get_M_defs + dest!: get_heap_E + elim!: bind_returns_heap_E2 + intro!: 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 CharacterDataMonad.get_M_defs split: option.splits)[1] - apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs + apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs 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 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 (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'" shows "character_data_ptr_kinds h = character_data_ptr_kinds h'" - by(simp add: character_data_ptr_kinds_def node_ptr_kinds_def preserved_def + by(simp add: character_data_ptr_kinds_def node_ptr_kinds_def preserved_def object_ptr_kinds_preserved_small[OF assms]) lemma character_data_ptr_kinds_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' + assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' \ (\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')" shows "character_data_ptr_kinds h = character_data_ptr_kinds h'" using writes_small_big[OF assms] @@ -491,27 +492,27 @@ lemma type_wf_preserved_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'" assumes "\node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" assumes "\element_ptr. preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr RElement.nothing) h h'" - assumes "\character_data_ptr. preserved (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 character_data_ptr + assumes "\character_data_ptr. preserved (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 character_data_ptr RCharacterData.nothing) h h'" shows "type_wf h = type_wf h'" - using type_wf_preserved_small[OF assms(1) assms(2) assms(3)] + using type_wf_preserved_small[OF assms(1) assms(2) assms(3)] allI[OF assms(4), of id, simplified] character_data_ptr_kinds_small[OF assms(1)] - apply(auto simp add: type_wf_defs preserved_def get_M_defs character_data_ptr_kinds_small[OF assms(1)] + apply(auto simp add: type_wf_defs preserved_def get_M_defs character_data_ptr_kinds_small[OF assms(1)] split: option.splits)[1] - apply(force) + apply(force) by force lemma type_wf_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \element_ptr. preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr RElement.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' - \ \character_data_ptr. preserved (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 character_data_ptr + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + \ \character_data_ptr. preserved (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 character_data_ptr RCharacterData.nothing) h h'" shows "type_wf h = type_wf h'" proof - @@ -523,9 +524,11 @@ proof - qed lemma type_wf_drop: "type_wf h \ type_wf (Heap (fmdrop ptr (the_heap h)))" - apply(auto simp add: type_wf_def ElementMonad.type_wf_drop + 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.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) + 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 diff --git a/Core_DOM/Core_DOM/common/monads/DocumentMonad.thy b/Core_DOM/Core_DOM/common/monads/DocumentMonad.thy index e0197ef..16747d6 100644 --- a/Core_DOM/Core_DOM/common/monads/DocumentMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/DocumentMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -36,11 +36,11 @@ theory DocumentMonad "../classes/DocumentClass" begin -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document, 'result) dom_prog = "((_) heap, exception, 'result) prog" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, - 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document, 'result) dom_prog" +register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, + 'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData, 'Document, 'result) dom_prog" global_interpretation l_ptr_kinds_M document_ptr_kinds defines document_ptr_kinds_M = a_ptr_kinds_M . @@ -49,21 +49,21 @@ lemmas document_ptr_kinds_M_defs = a_ptr_kinds_M_def lemma document_ptr_kinds_M_eq: assumes "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" shows "|h \ document_ptr_kinds_M|\<^sub>r = |h' \ document_ptr_kinds_M|\<^sub>r" - using assms + using assms by(auto simp add: document_ptr_kinds_M_defs object_ptr_kinds_M_defs document_ptr_kinds_def) -lemma document_ptr_kinds_M_reads: +lemma document_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)}) document_ptr_kinds_M h h'" using object_ptr_kinds_M_reads - apply (simp add: reads_def object_ptr_kinds_M_defs document_ptr_kinds_M_defs - document_ptr_kinds_def preserved_def cong del: image_cong_simp) + apply (simp add: reads_def object_ptr_kinds_M_defs document_ptr_kinds_M_defs + document_ptr_kinds_def preserved_def cong del: image_cong_simp) apply (metis (mono_tags, hide_lams) object_ptr_kinds_preserved_small old.unit.exhaust preserved_def) done global_interpretation l_dummy defines get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t = "l_get_M.a_get_M get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t" . lemma get_M_is_l_get_M: "l_get_M get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t type_wf document_ptr_kinds" apply(simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf l_get_M_def) - by (metis ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf ObjectClass.type_wf_defs bind_eq_None_conv + by (metis ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf ObjectClass.type_wf_defs bind_eq_None_conv document_ptr_kinds_commutes get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def option.simps(3)) lemmas get_M_defs = get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def[unfolded l_get_M.a_get_M_def[OF get_M_is_l_get_M]] @@ -83,7 +83,7 @@ end global_interpretation l_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales -global_interpretation l_put_M type_wf document_ptr_kinds get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t +global_interpretation l_put_M type_wf document_ptr_kinds get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t rewrites "a_get_M = get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t" defines put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t = a_put_M apply (simp add: get_M_is_l_get_M l_put_M_def) by (simp add: get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) @@ -106,84 +106,84 @@ end global_interpretation l_put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales -lemma document_put_get [simp]: - "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' - \ (\x. getter (setter (\_. v) x) = v) +lemma document_put_get [simp]: + "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' + \ (\x. getter (setter (\_. v) x) = v) \ h' \ get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr getter \\<^sub>r v" by(auto simp add: put_M_defs get_M_defs split: option.splits) -lemma get_M_Mdocument_preserved1 [simp]: - "document_ptr \ document_ptr' - \ h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' +lemma get_M_Mdocument_preserved1 [simp]: + "document_ptr \ document_ptr' + \ h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr' getter) h h'" by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma document_put_get_preserved [simp]: - "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' - \ (\x. getter (setter (\_. v) x) = getter x) +lemma document_put_get_preserved [simp]: + "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' + \ (\x. getter (setter (\_. v) x) = getter x) \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr' getter) h h'" - apply(cases "document_ptr = document_ptr'") + apply(cases "document_ptr = document_ptr'") by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved2 [simp]: +lemma get_M_Mdocument_preserved2 [simp]: "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_defs NodeMonad.get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + by(auto simp add: put_M_defs get_M_defs NodeMonad.get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved3 [simp]: - "cast document_ptr \ object_ptr - \ h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' +lemma get_M_Mdocument_preserved3 [simp]: + "cast document_ptr \ object_ptr + \ h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def ObjectMonad.get_M_defs + by(auto simp add: put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved4 [simp]: - "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' - \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Mdocument_preserved4 [simp]: + "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' + \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" apply(cases "cast document_ptr \ object_ptr")[1] - by(auto simp add: put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + ObjectMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E) -lemma get_M_Mdocument_preserved5 [simp]: - "cast document_ptr \ object_ptr - \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' +lemma get_M_Mdocument_preserved5 [simp]: + "cast document_ptr \ object_ptr + \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr getter) h h'" - by(auto simp add: ObjectMonad.put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def ObjectMonad.get_M_defs + by(auto simp add: ObjectMonad.put_M_defs get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved6 [simp]: +lemma get_M_Mdocument_preserved6 [simp]: "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter) h h'" - by(auto simp add: put_M_defs ElementMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs ElementMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved7 [simp]: +lemma get_M_Mdocument_preserved7 [simp]: "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr getter) h h'" - by(auto simp add: ElementMonad.put_M_defs get_M_defs preserved_def + by(auto simp add: ElementMonad.put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved8 [simp]: - "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' +lemma get_M_Mdocument_preserved8 [simp]: + "h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (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 character_data_ptr getter) h h'" - by(auto simp add: put_M_defs CharacterDataMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs CharacterDataMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved9 [simp]: - "h \ put_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 character_data_ptr setter v \\<^sub>h h' +lemma get_M_Mdocument_preserved9 [simp]: + "h \ put_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 character_data_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr getter) h h'" - by(auto simp add: CharacterDataMonad.put_M_defs get_M_defs preserved_def + by(auto simp add: CharacterDataMonad.put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Mdocument_preserved10 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Mdocument_preserved10 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - apply(cases "cast document_ptr = object_ptr") - by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def bind_eq_Some_conv + apply(cases "cast document_ptr = object_ptr") + by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def bind_eq_Some_conv split: option.splits) -lemma new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: +lemma new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: "h \ new_element \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" - by(auto simp add: new_element_def get_M_defs preserved_def + by(auto simp add: new_element_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_character_data_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: +lemma new_character_data_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: "h \ new_character_data \\<^sub>h h' \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" - by(auto simp add: new_character_data_def get_M_defs preserved_def + by(auto simp add: new_character_data_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) @@ -236,7 +236,7 @@ lemma new_document_doctype: assumes "h \ new_document \\<^sub>r new_document_ptr" shows "h' \ get_M new_document_ptr doctype \\<^sub>r ''''" using assms - by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_document_document_element: @@ -244,7 +244,7 @@ lemma new_document_document_element: assumes "h \ new_document \\<^sub>r new_document_ptr" shows "h' \ get_M new_document_ptr document_element \\<^sub>r None" using assms - by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_document_disconnected_nodes: @@ -252,33 +252,33 @@ lemma new_document_disconnected_nodes: assumes "h \ new_document \\<^sub>r new_document_ptr" shows "h' \ get_M new_document_ptr disconnected_nodes \\<^sub>r []" using assms - by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_document_def new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_document_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: - "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr +lemma new_document_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: + "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr \ ptr \ cast new_document_ptr \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr getter) h h'" - by(auto simp add: new_document_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: new_document_def ObjectMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_document_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: - "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr +lemma new_document_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: + "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr getter) h h'" - by(auto simp add: new_document_def NodeMonad.get_M_defs preserved_def + by(auto simp add: new_document_def NodeMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: - "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr +lemma new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: + "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" - by(auto simp add: new_document_def ElementMonad.get_M_defs preserved_def + by(auto simp add: new_document_def ElementMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_document_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: - "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr +lemma new_document_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: + "h \ new_document \\<^sub>h h' \ h \ new_document \\<^sub>r new_document_ptr \ preserved (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 ptr getter) h h'" - by(auto simp add: new_document_def CharacterDataMonad.get_M_defs preserved_def + by(auto simp add: new_document_def CharacterDataMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: - "h \ new_document \\<^sub>h h' - \ h \ new_document \\<^sub>r new_document_ptr \ ptr \ new_document_ptr +lemma new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: + "h \ new_document \\<^sub>h h' + \ h \ new_document \\<^sub>r new_document_ptr \ ptr \ new_document_ptr \ preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" by(auto simp add: new_document_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) @@ -287,13 +287,13 @@ lemma new_document_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n subsection \Modified Heaps\ -lemma get_document_ptr_simp [simp]: - "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma get_document_ptr_simp [simp]: + "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = (if ptr = cast document_ptr then cast obj else get document_ptr h)" by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def split: option.splits Option.bind_splits) -lemma document_ptr_kidns_simp [simp]: - "document_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma document_ptr_kidns_simp [simp]: + "document_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = document_ptr_kinds h |\| (if is_document_ptr_kind ptr then {|the (cast ptr)|} else {||})" by(auto simp add: document_ptr_kinds_def split: option.splits) @@ -310,7 +310,7 @@ 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!: CharacterDataMonad.type_wf_put_ptr_not_in_heap_E + by(auto simp add: type_wf_defs elim!: CharacterDataMonad.type_wf_put_ptr_not_in_heap_E split: option.splits if_splits) lemma type_wf_put_ptr_in_heap_E: @@ -320,145 +320,155 @@ lemma type_wf_put_ptr_in_heap_E: assumes "is_document_ptr_kind ptr \ is_document_kind (the (get ptr h))" shows "type_wf h" using assms - apply(auto simp add: type_wf_defs elim!: CharacterDataMonad.type_wf_put_ptr_in_heap_E + 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 notin_fset option.exhaust_sel) + 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) subsection \Preserving Types\ -lemma new_element_type_wf_preserved [simp]: +lemma new_element_type_wf_preserved [simp]: "h \ new_element \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def 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 + apply(auto simp add: new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def 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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def element_ptrs_def - elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E - 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 + elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E + 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 split: if_splits)[1] apply fastforce - by (metis Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def fMax_ge ffmember_filter + by (metis Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def fMax_ge ffmember_filter fimage_eqI is_element_ptr_ref) -lemma new_element_is_l_new_element [instances]: +lemma new_element_is_l_new_element [instances]: "l_new_element type_wf" using l_new_element.intro new_element_type_wf_preserved by blast lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: "h \ put_M element_ptr tag_name_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: ElementMonad.put_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 + apply(auto simp add: ElementMonad.put_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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + dest!: get_heap_E + elim!: bind_returns_heap_E2 + 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 CharacterDataClass.type_wf_defs split: option.splits)[1] - 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)) + 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]: +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'" - apply(auto simp add: ElementMonad.put_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 + apply(auto simp add: ElementMonad.put_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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + elim!: bind_returns_heap_E2 + 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 ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - 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)) + 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]: +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'" - apply(auto simp add: ElementMonad.put_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 + apply(auto simp add: ElementMonad.put_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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + elim!: bind_returns_heap_E2 + 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 ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - 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)) + 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'" - apply(auto simp add: ElementMonad.put_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 + apply(auto simp add: ElementMonad.put_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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + elim!: bind_returns_heap_E2 + 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 ElementMonad.get_M_defs ObjectClass.type_wf_defs CharacterDataClass.type_wf_defs split: option.splits)[1] - 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)) + 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]: +lemma new_character_data_type_wf_preserved [simp]: "h \ new_character_data \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: ElementMonad.put_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 + apply(auto simp add: ElementMonad.put_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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def new_character_data_def new\<^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 Let_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def dest!: get_heap_E elim!: bind_returns_heap_E2 bind_returns_heap_E type_wf_put_ptr_not_in_heap_E - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + 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] by (meson new\<^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 new\<^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_ptr_not_in_heap) -lemma new_character_data_is_l_new_character_data [instances]: +lemma new_character_data_is_l_new_character_data [instances]: "l_new_character_data type_wf" using l_new_character_data.intro new_character_data_type_wf_preserved by blast -lemma put_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_val_type_wf_preserved [simp]: +lemma put_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_val_type_wf_preserved [simp]: "h \ put_M character_data_ptr val_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: CharacterDataMonad.put_M_defs put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + apply(auto simp add: CharacterDataMonad.put_M_defs put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_kind_def - dest!: get_heap_E elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I ElementMonad.type_wf_put_I + dest!: get_heap_E elim!: bind_returns_heap_E2 + 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 CharacterDataMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.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 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) + 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 + 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 DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_ptr_kind_none - elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E - intro!: type_wf_put_I ElementMonad.type_wf_put_I CharacterDataMonad.type_wf_put_I - NodeMonad.type_wf_put_I ObjectMonad.type_wf_put_I - split: if_splits)[1] - apply(auto simp add: type_wf_defs ElementClass.type_wf_defs CharacterDataClass.type_wf_defs - NodeClass.type_wf_defs ObjectClass.type_wf_defs is_document_kind_def + elim!: bind_returns_heap_E type_wf_put_ptr_not_in_heap_E + intro!: type_wf_put_I ElementMonad.type_wf_put_I CharacterDataMonad.type_wf_put_I + NodeMonad.type_wf_put_I ObjectMonad.type_wf_put_I + split: if_splits)[1] + apply(auto simp add: type_wf_defs ElementClass.type_wf_defs CharacterDataClass.type_wf_defs + NodeClass.type_wf_defs ObjectClass.type_wf_defs is_document_kind_def split: option.splits)[1] 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) + 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 + @@ -468,59 +478,59 @@ lemma new_document_is_l_new_document [instances]: "l_new_document type_wf" using l_new_document.intro new_document_type_wf_preserved by blast -lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_doctype_type_wf_preserved [simp]: +lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_doctype_type_wf_preserved [simp]: "h \ put_M document_ptr doctype_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: put_M_defs put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I + apply(auto simp add: put_M_defs put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def dest!: get_heap_E + elim!: bind_returns_heap_E2 + 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_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: is_document_kind_def type_wf_defs ElementClass.type_wf_defs - NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs + apply(auto simp add: is_document_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(auto simp add: get_M_defs)[1] 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]: +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'" - apply(auto simp add: put_M_defs put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + apply(auto simp add: put_M_defs put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def DocumentClass.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 DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t DocumentClass.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_ptr_kind_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none is_document_kind_def - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I - ElementMonad.type_wf_put_I NodeMonad.type_wf_put_I + dest!: get_heap_E + elim!: bind_returns_heap_E2 + 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: get_M_defs is_document_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 + apply(auto simp add: get_M_defs is_document_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] 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]: +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'" apply(auto simp add: put_M_defs put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def DocumentClass.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 @@ -529,13 +539,13 @@ lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_disc DocumentClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t is_node_ptr_kind_none cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_none is_document_kind_def - dest!: get_heap_E - elim!: bind_returns_heap_E2 - intro!: type_wf_put_I CharacterDataMonad.type_wf_put_I + dest!: get_heap_E + elim!: bind_returns_heap_E2 + 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_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 + ObjectMonad.type_wf_put_I)[1] + 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 finite_set_in) @@ -547,7 +557,7 @@ lemma document_ptr_kinds_small: lemma document_ptr_kinds_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' + assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' \ (\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')" shows "document_ptr_kinds h = document_ptr_kinds h'" using writes_small_big[OF assms] @@ -558,33 +568,33 @@ lemma type_wf_preserved_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'" assumes "\node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" assumes "\element_ptr. preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr RElement.nothing) h h'" - assumes "\character_data_ptr. preserved + assumes "\character_data_ptr. preserved (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 character_data_ptr RCharacterData.nothing) h h'" assumes "\document_ptr. preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr RDocument.nothing) h h'" shows "DocumentClass.type_wf h = DocumentClass.type_wf h'" - using type_wf_preserved_small[OF assms(1) assms(2) assms(3) assms(4)] + using type_wf_preserved_small[OF assms(1) assms(2) assms(3) assms(4)] allI[OF assms(5), of id, simplified] document_ptr_kinds_small[OF assms(1)] apply(auto simp add: type_wf_defs )[1] - apply(auto simp add: type_wf_defs preserved_def get_M_defs document_ptr_kinds_small[OF assms(1)] + apply(auto simp add: type_wf_defs preserved_def get_M_defs document_ptr_kinds_small[OF assms(1)] split: option.splits)[1] apply force - apply(auto simp add: type_wf_defs preserved_def get_M_defs document_ptr_kinds_small[OF assms(1)] + apply(auto simp add: type_wf_defs preserved_def get_M_defs document_ptr_kinds_small[OF assms(1)] split: option.splits)[1] by force lemma type_wf_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \element_ptr. preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr RElement.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' - \ \character_data_ptr. preserved + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + \ \character_data_ptr. preserved (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 character_data_ptr RCharacterData.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \document_ptr. preserved (get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr RDocument.nothing) h h'" shows "DocumentClass.type_wf h = DocumentClass.type_wf h'" proof - @@ -599,5 +609,6 @@ 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 (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) + 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/Core_DOM/common/monads/ElementMonad.thy b/Core_DOM/Core_DOM/common/monads/ElementMonad.thy index b3cd318..846ce68 100644 --- a/Core_DOM/Core_DOM/common/monads/ElementMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/ElementMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -35,11 +35,11 @@ theory ElementMonad "ElementClass" begin -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element,'result) dom_prog = "((_) heap, exception, 'result) prog" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, - 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element,'result) dom_prog" +register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, + 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element,'result) dom_prog" global_interpretation l_ptr_kinds_M element_ptr_kinds defines element_ptr_kinds_M = a_ptr_kinds_M . @@ -49,10 +49,10 @@ lemmas element_ptr_kinds_M_defs = a_ptr_kinds_M_def lemma element_ptr_kinds_M_eq: assumes "|h \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" shows "|h \ element_ptr_kinds_M|\<^sub>r = |h' \ element_ptr_kinds_M|\<^sub>r" - using assms + using assms by(auto simp add: element_ptr_kinds_M_defs node_ptr_kinds_M_defs element_ptr_kinds_def) -lemma element_ptr_kinds_M_reads: +lemma element_ptr_kinds_M_reads: "reads (\element_ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t element_ptr RObject.nothing)}) element_ptr_kinds_M h h'" apply (simp add: reads_def node_ptr_kinds_M_defs element_ptr_kinds_M_defs element_ptr_kinds_def node_ptr_kinds_M_reads preserved_def cong del: image_cong_simp) @@ -62,8 +62,8 @@ lemma element_ptr_kinds_M_reads: global_interpretation l_dummy defines get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t = "l_get_M.a_get_M get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t" . lemma get_M_is_l_get_M: "l_get_M get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t type_wf element_ptr_kinds" apply(simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf l_get_M_def) - by (metis (no_types, lifting) ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf ObjectClass.type_wf_defs - bind_eq_Some_conv bind_eq_Some_conv element_ptr_kinds_commutes get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + by (metis (no_types, lifting) ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf ObjectClass.type_wf_defs + bind_eq_Some_conv bind_eq_Some_conv element_ptr_kinds_commutes 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 node_ptr_kinds_commutes option.simps(3)) lemmas get_M_defs = get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def[unfolded l_get_M.a_get_M_def[OF get_M_is_l_get_M]] @@ -84,8 +84,8 @@ end global_interpretation l_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales -global_interpretation l_put_M type_wf element_ptr_kinds get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t - rewrites "a_get_M = get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t" +global_interpretation l_put_M type_wf element_ptr_kinds get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t + rewrites "a_get_M = get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t" defines put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t = a_put_M apply (simp add: get_M_is_l_get_M l_put_M_def) by (simp add: get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) @@ -109,74 +109,74 @@ end global_interpretation l_put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales -lemma element_put_get [simp]: - "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ (\x. getter (setter (\_. v) x) = v) +lemma element_put_get [simp]: + "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ (\x. getter (setter (\_. v) x) = v) \ h' \ get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter \\<^sub>r v" by(auto simp add: put_M_defs get_M_defs split: option.splits) -lemma get_M_Element_preserved1 [simp]: - "element_ptr \ element_ptr' \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' +lemma get_M_Element_preserved1 [simp]: + "element_ptr \ element_ptr' \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr' getter) h h'" by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma element_put_get_preserved [simp]: - "(\x. getter (setter (\_. v) x) = getter x) \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' +lemma element_put_get_preserved [simp]: + "(\x. getter (setter (\_. v) x) = getter x) \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr' getter) h h'" - apply(cases "element_ptr = element_ptr'") - by(auto simp add: put_M_defs get_M_defs preserved_def + apply(cases "element_ptr = element_ptr'") + by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Element_preserved3 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Element_preserved3 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - apply(cases "cast element_ptr = object_ptr") - by (auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs 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 preserved_def 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 bind_eq_Some_conv + apply(cases "cast element_ptr = object_ptr") + by (auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs 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 preserved_def 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 bind_eq_Some_conv split: option.splits) -lemma get_M_Element_preserved4 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Element_preserved4 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" - apply(cases "cast element_ptr = node_ptr") - by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs 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 preserved_def 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 bind_eq_Some_conv + apply(cases "cast element_ptr = node_ptr") + by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs NodeMonad.get_M_defs 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 preserved_def 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 bind_eq_Some_conv split: option.splits) -lemma get_M_Element_preserved5 [simp]: - "cast element_ptr \ node_ptr \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' +lemma get_M_Element_preserved5 [simp]: + "cast element_ptr \ node_ptr \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Element_preserved6 [simp]: - "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' - \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Element_preserved6 [simp]: + "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' + \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" apply(cases "cast element_ptr \ node_ptr") - by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E) -lemma get_M_Element_preserved7 [simp]: - "cast element_ptr \ node_ptr \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' +lemma get_M_Element_preserved7 [simp]: + "cast element_ptr \ node_ptr \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter) h h'" - by(auto simp add: NodeMonad.put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def + by(auto simp add: NodeMonad.put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def NodeMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Element_preserved8 [simp]: - "cast element_ptr \ object_ptr \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' +lemma get_M_Element_preserved8 [simp]: + "cast element_ptr \ object_ptr \ h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_defs 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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs 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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Element_preserved9 [simp]: - "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' - \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Element_preserved9 [simp]: + "h \ put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \\<^sub>h h' + \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" apply(cases "cast element_ptr \ object_ptr") - by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def - ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + ObjectMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E) -lemma get_M_Element_preserved10 [simp]: - "cast element_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' +lemma get_M_Element_preserved10 [simp]: + "cast element_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter) h h'" - by(auto simp add: ObjectMonad.put_M_defs get_M_defs 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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def - ObjectMonad.get_M_defs preserved_def + by(auto simp add: ObjectMonad.put_M_defs get_M_defs 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 put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) subsection\Creating Elements\ @@ -208,7 +208,7 @@ lemma new_element_ptr_not_in_heap: and "h \ new_element \\<^sub>r new_element_ptr" shows "new_element_ptr |\| element_ptr_kinds h" using assms new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_not_in_heap - by(auto simp add: new_element_def split: prod.splits elim!: bind_returns_result_E + by(auto simp add: new_element_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_element_new_ptr: @@ -216,7 +216,7 @@ lemma new_element_new_ptr: and "h \ new_element \\<^sub>r new_element_ptr" shows "object_ptr_kinds h' = object_ptr_kinds h |\| {|cast new_element_ptr|}" using assms new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_new_ptr - by(auto simp add: new_element_def split: prod.splits elim!: bind_returns_result_E + by(auto simp add: new_element_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_element_is_element_ptr: @@ -230,7 +230,7 @@ lemma new_element_child_nodes: assumes "h \ new_element \\<^sub>r new_element_ptr" shows "h' \ get_M new_element_ptr child_nodes \\<^sub>r []" using assms - by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_element_tag_name: @@ -238,7 +238,7 @@ lemma new_element_tag_name: assumes "h \ new_element \\<^sub>r new_element_ptr" shows "h' \ get_M new_element_ptr tag_name \\<^sub>r ''''" using assms - by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_element_attrs: @@ -246,7 +246,7 @@ lemma new_element_attrs: assumes "h \ new_element \\<^sub>r new_element_ptr" shows "h' \ get_M new_element_ptr attrs \\<^sub>r fmempty" using assms - by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) lemma new_element_shadow_root_opt: @@ -254,35 +254,35 @@ lemma new_element_shadow_root_opt: assumes "h \ new_element \\<^sub>r new_element_ptr" shows "h' \ get_M new_element_ptr shadow_root_opt \\<^sub>r None" using assms - by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def + by(auto simp add: get_M_defs new_element_def new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: - "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ cast new_element_ptr +lemma new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: + "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ cast new_element_ptr \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr getter) h h'" - by(auto simp add: new_element_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: new_element_def ObjectMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_element_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: - "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ cast new_element_ptr +lemma new_element_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e: + "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ cast new_element_ptr \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr getter) h h'" - by(auto simp add: new_element_def NodeMonad.get_M_defs preserved_def + by(auto simp add: new_element_def NodeMonad.get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) -lemma new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: - "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ new_element_ptr +lemma new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t: + "h \ new_element \\<^sub>h h' \ h \ new_element \\<^sub>r new_element_ptr \ ptr \ new_element_ptr \ preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr getter) h h'" - by(auto simp add: new_element_def get_M_defs preserved_def + by(auto simp add: new_element_def get_M_defs preserved_def split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E) subsection\Modified Heaps\ -lemma get_Element_ptr_simp [simp]: - "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma get_Element_ptr_simp [simp]: + "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = (if ptr = cast element_ptr then cast obj else get element_ptr h)" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def split: option.splits Option.bind_splits) -lemma element_ptr_kinds_simp [simp]: - "element_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma element_ptr_kinds_simp [simp]: + "element_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = element_ptr_kinds h |\| (if is_element_ptr_kind ptr then {|the (cast ptr)|} else {||})" by(auto simp add: element_ptr_kinds_def is_node_ptr_kind_def split: option.splits) @@ -299,7 +299,7 @@ lemma type_wf_put_ptr_not_in_heap_E: assumes "ptr |\| object_ptr_kinds h" shows "type_wf h" using assms - apply(auto simp add: type_wf_defs elim!: NodeMonad.type_wf_put_ptr_not_in_heap_E + 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 @@ -318,8 +318,8 @@ lemma type_wf_put_ptr_in_heap_E: subsection\Preserving Types\ lemma new_element_type_wf_preserved [simp]: "h \ new_element \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def - new_element_def Let_def 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 + apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def + new_element_def Let_def 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 if_splits elim!: bind_returns_heap_E)[1] apply (metis element_ptr_kinds_commutes element_ptrs_def fempty_iff ffmember_filter finite_set_in @@ -340,39 +340,39 @@ lemma new_element_is_l_new_element: "l_new_element type_wf" lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: "h \ put_M element_ptr tag_name_update v \\<^sub>h h' \ type_wf h = type_wf h'" - apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs - 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 + apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs + 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 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]: +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'" - apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs - 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 + apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs + 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 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]: +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'" - apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs 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 + apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs 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 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]: +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'" - apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs - 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 + apply(auto simp add: type_wf_defs NodeClass.type_wf_defs ObjectClass.type_wf_defs + 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 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) @@ -381,15 +381,15 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ 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'" shows "object_ptr_kinds h = object_ptr_kinds h'" - using assms - apply(auto simp add: put_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 + using assms + apply(auto simp add: put_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 elim!: bind_returns_heap_E2 dest!: get_heap_E)[1] by (meson get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap is_OK_returns_result_I) lemma element_ptr_kinds_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' + assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' \ (\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')" shows "element_ptr_kinds h = element_ptr_kinds h'" using writes_small_big[OF assms] @@ -400,7 +400,7 @@ lemma element_ptr_kinds_preserved: lemma element_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'" shows "element_ptr_kinds h = element_ptr_kinds h'" - by(simp add: element_ptr_kinds_def node_ptr_kinds_def preserved_def + by(simp add: element_ptr_kinds_def node_ptr_kinds_def preserved_def object_ptr_kinds_preserved_small[OF assms]) lemma type_wf_preserved_small: @@ -410,19 +410,19 @@ lemma type_wf_preserved_small: shows "type_wf h = type_wf h'" using type_wf_preserved_small[OF assms(1) assms(2)] allI[OF assms(3), of id, simplified] apply(auto simp add: type_wf_defs )[1] - apply(auto simp add: preserved_def get_M_defs element_ptr_kinds_small[OF assms(1)] + apply(auto simp add: preserved_def get_M_defs element_ptr_kinds_small[OF assms(1)] split: option.splits,force)[1] - by(auto simp add: preserved_def get_M_defs element_ptr_kinds_small[OF assms(1)] + by(auto simp add: preserved_def get_M_defs element_ptr_kinds_small[OF assms(1)] split: option.splits,force) lemma type_wf_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \element_ptr. preserved (get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr RElement.nothing) h h'" shows "type_wf h = type_wf h'" proof - @@ -434,8 +434,8 @@ proof - qed lemma type_wf_drop: "type_wf h \ type_wf (Heap (fmdrop ptr (the_heap h)))" - 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 + 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 (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) diff --git a/Core_DOM/Core_DOM/common/monads/NodeMonad.thy b/Core_DOM/Core_DOM/common/monads/NodeMonad.thy index 317a1e1..832f997 100644 --- a/Core_DOM/Core_DOM/common/monads/NodeMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/NodeMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -37,7 +37,7 @@ begin type_synonym ('object_ptr, 'node_ptr, 'Object, 'Node, 'result) dom_prog = "((_) heap, exception, 'result) prog" -register_default_tvars "('object_ptr, 'node_ptr, 'Object, 'Node, 'result) dom_prog" +register_default_tvars "('object_ptr, 'node_ptr, 'Object, 'Node, 'result) dom_prog" global_interpretation l_ptr_kinds_M node_ptr_kinds defines node_ptr_kinds_M = a_ptr_kinds_M . @@ -46,14 +46,14 @@ lemmas node_ptr_kinds_M_defs = a_ptr_kinds_M_def lemma node_ptr_kinds_M_eq: assumes "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" shows "|h \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" - using assms + using assms by(auto simp add: node_ptr_kinds_M_defs object_ptr_kinds_M_defs node_ptr_kinds_def) global_interpretation l_dummy defines get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e = "l_get_M.a_get_M get\<^sub>N\<^sub>o\<^sub>d\<^sub>e" . lemma get_M_is_l_get_M: "l_get_M get\<^sub>N\<^sub>o\<^sub>d\<^sub>e type_wf node_ptr_kinds" apply(simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf l_get_M_def) - by (metis ObjectClass.a_type_wf_def ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind_eq_None_conv get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + by (metis ObjectClass.a_type_wf_def ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind_eq_None_conv get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def node_ptr_kinds_commutes option.simps(3)) lemmas get_M_defs = get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def[unfolded l_get_M.a_get_M_def[OF get_M_is_l_get_M]] @@ -72,15 +72,15 @@ end global_interpretation l_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas type_wf by unfold_locales -lemma node_ptr_kinds_M_reads: +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) 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" +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" defines put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e = a_put_M apply (simp add: get_M_is_l_get_M l_put_M_def) by (simp add: get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) @@ -102,40 +102,40 @@ end global_interpretation l_put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas type_wf by unfold_locales -lemma get_M_Object_preserved1 [simp]: - "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' +lemma get_M_Object_preserved1 [simp]: + "(\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - apply(cases "cast node_ptr = object_ptr") - by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def - bind_eq_Some_conv + apply(cases "cast node_ptr = object_ptr") + by(auto simp add: put_M_defs get_M_defs ObjectMonad.get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def preserved_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def + bind_eq_Some_conv split: option.splits) -lemma get_M_Object_preserved2 [simp]: - "cast node_ptr \ object_ptr \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' +lemma get_M_Object_preserved2 [simp]: + "cast node_ptr \ object_ptr \ h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" - by(auto simp add: put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) -lemma get_M_Object_preserved3 [simp]: - "h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) +lemma get_M_Object_preserved3 [simp]: + "h \ put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \\<^sub>h h' \ (\x. getter (cast (setter (\_. v) x)) = getter (cast x)) \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr getter) h h'" apply(cases "cast node_ptr \ object_ptr") - by(auto simp add: put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits bind_splits dest: get_heap_E) -lemma get_M_Object_preserved4 [simp]: - "cast node_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' +lemma get_M_Object_preserved4 [simp]: + "cast node_ptr \ object_ptr \ h \ put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \\<^sub>h h' \ preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'" - by(auto simp add: ObjectMonad.put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def + by(auto simp add: ObjectMonad.put_M_defs get_M_defs get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def ObjectMonad.get_M_defs preserved_def split: option.splits dest: get_heap_E) subsection\Modified Heaps\ -lemma get_node_ptr_simp [simp]: +lemma get_node_ptr_simp [simp]: "get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = (if ptr = cast node_ptr then cast obj else get node_ptr h)" by(auto simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) -lemma node_ptr_kinds_simp [simp]: - "node_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) +lemma node_ptr_kinds_simp [simp]: + "node_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = node_ptr_kinds h |\| (if is_node_ptr_kind ptr then {|the (cast ptr)|} else {||})" by(auto simp add: node_ptr_kinds_def) @@ -155,7 +155,7 @@ 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!: ObjectMonad.type_wf_put_ptr_not_in_heap_E + by(auto simp add: type_wf_defs elim!: ObjectMonad.type_wf_put_ptr_not_in_heap_E split: option.splits if_splits) lemma type_wf_put_ptr_in_heap_E: @@ -179,7 +179,7 @@ lemma node_ptr_kinds_small: lemma node_ptr_kinds_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' + assumes "\h h'. \w \ SW. h \ w \\<^sub>h h' \ (\object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')" shows "node_ptr_kinds h = node_ptr_kinds h'" using writes_small_big[OF assms] @@ -202,9 +202,9 @@ lemma type_wf_preserved_small: lemma type_wf_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" - assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'" shows "type_wf h = type_wf h'" proof - diff --git a/Core_DOM/Core_DOM/common/monads/ObjectMonad.thy b/Core_DOM/Core_DOM/common/monads/ObjectMonad.thy index 69c3a86..e9e68d0 100644 --- a/Core_DOM/Core_DOM/common/monads/ObjectMonad.thy +++ b/Core_DOM/Core_DOM/common/monads/ObjectMonad.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -37,7 +37,7 @@ begin type_synonym ('object_ptr, 'Object, 'result) dom_prog = "((_) heap, exception, 'result) prog" -register_default_tvars "('object_ptr, 'Object, 'result) dom_prog" +register_default_tvars "('object_ptr, 'Object, 'result) dom_prog" global_interpretation l_ptr_kinds_M object_ptr_kinds defines object_ptr_kinds_M = a_ptr_kinds_M . lemmas object_ptr_kinds_M_defs = a_ptr_kinds_M_def @@ -63,16 +63,16 @@ end global_interpretation l_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas type_wf by (simp add: l_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas_def l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_axioms) -lemma object_ptr_kinds_M_reads: +lemma object_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)}) object_ptr_kinds_M h h'" - apply(auto simp add: object_ptr_kinds_M_defs get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf type_wf_defs reads_def - preserved_def get_M_defs + apply(auto simp add: object_ptr_kinds_M_defs get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf type_wf_defs reads_def + preserved_def get_M_defs split: option.splits)[1] using a_type_wf_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf by blast+ -global_interpretation l_put_M type_wf object_ptr_kinds get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t - rewrites "a_get_M = get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t" +global_interpretation l_put_M type_wf object_ptr_kinds get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t + rewrites "a_get_M = get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t" defines put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t = a_put_M apply (simp add: get_M_is_l_get_M l_put_M_def) by (simp add: get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def) @@ -108,35 +108,35 @@ lemma check_in_heap_ptr_in_heap: "ptr |\| object_ptr_kinds h \| object_ptr_kinds h \ h \ ok (check_in_heap ptr \ f) = h \ ok (f ())" by(simp add: check_in_heap_def) -lemma check_in_heap_returns_result [simp]: +lemma check_in_heap_returns_result [simp]: "ptr |\| object_ptr_kinds h \ h \ (check_in_heap ptr \ f) \\<^sub>r x = h \ f () \\<^sub>r x" by(simp add: check_in_heap_def) -lemma check_in_heap_returns_heap [simp]: +lemma check_in_heap_returns_heap [simp]: "ptr |\| object_ptr_kinds h \ h \ (check_in_heap ptr \ f) \\<^sub>h h' = h \ f () \\<^sub>h h'" by(simp add: check_in_heap_def) -lemma check_in_heap_reads: +lemma check_in_heap_reads: "reads {preserved (get_M object_ptr nothing)} (check_in_heap object_ptr) h h'" apply(simp add: check_in_heap_def reads_def preserved_def) - by (metis a_type_wf_def get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap is_OK_returns_result_E + by (metis a_type_wf_def get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I unit_all_impI) subsection\Invoke\ -fun invoke_rec :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ 'args - \ (_, 'result) dom_prog)) list \ (_) object_ptr \ 'args +fun invoke_rec :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ 'args + \ (_, 'result) dom_prog)) list \ (_) object_ptr \ 'args \ (_, 'result) dom_prog" where "invoke_rec ((P, f)#xs) ptr args = (if P ptr then f ptr args else invoke_rec xs ptr args)" | "invoke_rec [] ptr args = error InvokeError" -definition invoke :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ 'args - \ (_, 'result) dom_prog)) list +definition invoke :: "(((_) object_ptr \ bool) \ ((_) object_ptr \ 'args + \ (_, 'result) dom_prog)) list \ (_) object_ptr \ 'args \ (_, 'result) dom_prog" - where + where "invoke xs ptr args = do { check_in_heap ptr; invoke_rec xs ptr args}" lemma invoke_split: "P (invoke ((Pred, f) # xs) ptr args) = @@ -156,16 +156,16 @@ lemma invoke_ptr_in_heap: "h \ ok (invoke xs ptr args) \| object_ptr_kinds h \ Pred ptr +lemma invoke_is_OK [simp]: + "ptr |\| object_ptr_kinds h \ Pred ptr \ h \ ok (invoke ((Pred, f) # xs) ptr args) = h \ ok (f ptr args)" by(simp add: invoke_def) -lemma invoke_returns_result [simp]: - "ptr |\| object_ptr_kinds h \ Pred ptr +lemma invoke_returns_result [simp]: + "ptr |\| object_ptr_kinds h \ Pred ptr \ h \ (invoke ((Pred, f) # xs) ptr args) \\<^sub>r x = h \ f ptr args \\<^sub>r x" by(simp add: invoke_def) -lemma invoke_returns_heap [simp]: - "ptr |\| object_ptr_kinds h \ Pred ptr +lemma invoke_returns_heap [simp]: + "ptr |\| object_ptr_kinds h \ Pred ptr \ h \ (invoke ((Pred, f) # xs) ptr args) \\<^sub>h h' = h \ f ptr args \\<^sub>h h'" by(simp add: invoke_def) @@ -182,7 +182,7 @@ lemma invoke_empty_reads [simp]: "\P \ S. reflp P \ transp P \< subsection\Modified Heaps\ -lemma get_object_ptr_simp [simp]: +lemma get_object_ptr_simp [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 ptr obj h) = (if ptr = object_ptr then Some obj else get object_ptr h)" by(auto simp add: get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: option.splits Option.bind_splits) @@ -220,17 +220,17 @@ lemma object_ptr_kinds_preserved_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'" shows "object_ptr_kinds h = object_ptr_kinds h'" using assms - apply(auto simp add: object_ptr_kinds_def preserved_def get_M_defs get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def + apply(auto simp add: object_ptr_kinds_def preserved_def get_M_defs get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: option.splits)[1] - apply (metis (mono_tags, lifting) domIff error_returns_result fmdom.rep_eq fmember.rep_eq + apply (metis (mono_tags, lifting) domIff error_returns_result fmdom.rep_eq fmember.rep_eq old.unit.exhaust option.case_eq_if return_returns_result) - by (metis (mono_tags, lifting) domIff error_returns_result fmdom.rep_eq fmember.rep_eq + by (metis (mono_tags, lifting) domIff error_returns_result fmdom.rep_eq fmember.rep_eq old.unit.exhaust option.case_eq_if return_returns_result) lemma object_ptr_kinds_preserved: assumes "writes SW setter h h'" assumes "h \ setter \\<^sub>h h'" - assumes "\h h' w object_ptr. w \ SW \ h \ w \\<^sub>h h' + assumes "\h h' w object_ptr. w \ SW \ h \ w \\<^sub>h h' \ preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" shows "object_ptr_kinds h = object_ptr_kinds h'" proof - diff --git a/Core_DOM/Core_DOM/common/pointers/CharacterDataPointer.thy b/Core_DOM/Core_DOM/common/pointers/CharacterDataPointer.thy index 147eb15..3df494a 100644 --- a/Core_DOM/Core_DOM/common/pointers/CharacterDataPointer.thy +++ b/Core_DOM/Core_DOM/common/pointers/CharacterDataPointer.thy @@ -23,25 +23,25 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\CharacterData\ -text\In this theory, we introduce the typed pointers for the class CharacterData.\ +text\In this theory, we introduce the typed pointers for the class CharacterData.\ theory CharacterDataPointer imports ElementPointer begin datatype 'character_data_ptr character_data_ptr = Ref (the_ref: ref) | Ext 'character_data_ptr -register_default_tvars "'character_data_ptr character_data_ptr" +register_default_tvars "'character_data_ptr character_data_ptr" type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr = "('character_data_ptr character_data_ptr + 'node_ptr, 'element_ptr) node_ptr" -register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr" type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr) object_ptr = "('object_ptr, 'character_data_ptr character_data_ptr + 'node_ptr, 'element_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr) object_ptr" +register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr) object_ptr" definition 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 :: "(_) character_data_ptr \ (_) node_ptr" where @@ -53,7 +53,7 @@ abbreviation cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub> definition cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 :: "(_) node_ptr \ (_) character_data_ptr option" where - "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 node_ptr = (case node_ptr of + "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 node_ptr = (case node_ptr of node_ptr.Ext (Inr (Inl character_data_ptr)) \ Some character_data_ptr | _ \ None)" @@ -63,29 +63,29 @@ abbreviation cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub> Some node_ptr \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 node_ptr | None \ None)" -adhoc_overloading cast 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 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 +adhoc_overloading cast 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 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 cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 consts is_character_data_ptr_kind :: 'a definition is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \ bool" where - "is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 ptr + "is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 ptr of Some _ \ True | _ \ False)" abbreviation is_character_data_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" where - "is_character_data_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + "is_character_data_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of Some node_ptr \ is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr | None \ False)" -adhoc_overloading is_character_data_ptr_kind is_character_data_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r +adhoc_overloading is_character_data_ptr_kind is_character_data_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r lemmas is_character_data_ptr_kind_def = is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def consts is_character_data_ptr :: 'a definition is_character_data_ptr\<^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 :: "(_) character_data_ptr \ bool" where - "is_character_data_ptr\<^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 ptr = (case ptr + "is_character_data_ptr\<^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 ptr = (case ptr of character_data_ptr.Ref _ \ True | _ \ False)" abbreviation is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \ bool" @@ -105,7 +105,7 @@ adhoc_overloading is_character_data_ptr lemmas is_character_data_ptr_def = is_character_data_ptr\<^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 consts is_character_data_ptr_ext :: 'a -abbreviation +abbreviation "is_character_data_ptr_ext\<^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 ptr \ \ is_character_data_ptr\<^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 ptr" abbreviation "is_character_data_ptr_ext\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 ptr of @@ -121,17 +121,17 @@ adhoc_overloading is_character_data_ptr_ext instantiation character_data_ptr :: (linorder) linorder begin -definition +definition less_eq_character_data_ptr :: "(_::linorder) character_data_ptr \ (_) character_data_ptr \ bool" - where + where "less_eq_character_data_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j | Ref _ \ False) | Ref i \ (case y of Ext _ \ True | Ref j \ i \ j))" -definition +definition less_character_data_ptr :: "(_::linorder) character_data_ptr \ (_) character_data_ptr \ bool" where "less_character_data_ptr x y \ x \ y \ \ y \ x" -instance - apply(standard) - by(auto simp add: less_eq_character_data_ptr_def less_character_data_ptr_def +instance + apply(standard) + by(auto simp add: less_eq_character_data_ptr_def less_character_data_ptr_def split: character_data_ptr.splits) end @@ -141,20 +141,20 @@ lemma is_character_data_ptr_ref [simp]: "is_character_data_ptr (character_data_p lemma cast_element_ptr_not_character_data_ptr [simp]: "(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 element_ptr \ cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r character_data_ptr)" "(cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r character_data_ptr \ cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr)" - unfolding 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_def 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_def + unfolding 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_def 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_def by(auto) -lemma is_character_data_ptr_kind_not_element_ptr [simp]: +lemma is_character_data_ptr_kind_not_element_ptr [simp]: "\ is_character_data_ptr_kind (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 element_ptr)" unfolding is_character_data_ptr_kind_def 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 by auto -lemma is_element_ptr_kind_not_character_data_ptr [simp]: +lemma is_element_ptr_kind_not_character_data_ptr [simp]: "\ is_element_ptr_kind (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 character_data_ptr)" using is_element_ptr_kind_obtains by fastforce -lemma is_character_data_ptr_kind\<^sub>_cast [simp]: +lemma is_character_data_ptr_kind\<^sub>_cast [simp]: "is_character_data_ptr_kind (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 character_data_ptr)" - by (simp add: 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 + by (simp add: 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) lemma character_data_ptr_casts_commute [simp]: @@ -171,14 +171,14 @@ lemma character_data_ptr_casts_commute3 [simp]: assumes "is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr" shows "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 (the (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 node_ptr)) = node_ptr" using assms - by(auto simp add: is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 + by(auto simp add: is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 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_def split: node_ptr.splits sum.splits) lemma is_character_data_ptr_kind_obtains: assumes "is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr" obtains character_data_ptr where "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 character_data_ptr = node_ptr" - by (metis assms is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def case_optionE + by (metis assms is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def case_optionE character_data_ptr_casts_commute) lemma is_character_data_ptr_kind_none: @@ -188,11 +188,11 @@ lemma is_character_data_ptr_kind_none: unfolding is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 by(auto split: node_ptr.splits sum.splits) -lemma 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_inject [simp]: +lemma 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_inject [simp]: "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 x = 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 y \ x = y" by(simp add: 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_def) -lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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_ext_none [simp]: +lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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_ext_none [simp]: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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 (node_ptr.Ext (Inr (Inr node_ext_ptr))) = None" by(simp add: cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^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) diff --git a/Core_DOM/Core_DOM/common/pointers/DocumentPointer.thy b/Core_DOM/Core_DOM/common/pointers/DocumentPointer.thy index f207887..a718fa9 100644 --- a/Core_DOM/Core_DOM/common/pointers/DocumentPointer.thy +++ b/Core_DOM/Core_DOM/common/pointers/DocumentPointer.thy @@ -23,22 +23,22 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Document\ -text\In this theory, we introduce the typed pointers for the class Document.\ +text\In this theory, we introduce the typed pointers for the class Document.\ theory DocumentPointer imports CharacterDataPointer begin datatype 'document_ptr document_ptr = Ref (the_ref: ref) | Ext 'document_ptr -register_default_tvars "'document_ptr document_ptr" +register_default_tvars "'document_ptr document_ptr" type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr) object_ptr = "('document_ptr document_ptr + 'object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr) object_ptr" +register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr) object_ptr" definition 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 \ (_) object_ptr" where @@ -46,8 +46,8 @@ definition cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\ definition 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 :: "(_) object_ptr \ (_) document_ptr option" where - "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 = (case ptr of - object_ptr.Ext (Inr (Inl document_ptr)) \ Some document_ptr + "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 = (case ptr of + object_ptr.Ext (Inr (Inl document_ptr)) \ Some document_ptr | _ \ None)" adhoc_overloading cast 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 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 @@ -55,7 +55,7 @@ adhoc_overloading cast cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^su definition is_document_ptr_kind :: "(_) object_ptr \ bool" where - "is_document_ptr_kind ptr = (case 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 of + "is_document_ptr_kind ptr = (case 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 of Some _ \ True | None \ False)" consts is_document_ptr :: 'a @@ -86,8 +86,8 @@ definition less_eq_document_ptr :: "(_::linorder) document_ptr \ (_) | Ref i \ (case y of Ext _ \ True | Ref j \ i \ j))" definition less_document_ptr :: "(_::linorder) document_ptr \ (_) document_ptr \ bool" where "less_document_ptr x y \ x \ y \ \ y \ x" -instance - apply(standard) +instance + apply(standard) by(auto simp add: less_eq_document_ptr_def less_document_ptr_def split: document_ptr.splits) end @@ -97,17 +97,17 @@ lemma is_document_ptr_ref [simp]: "is_document_ptr (document_ptr.Ref n)" lemma cast_document_ptr_not_node_ptr [simp]: "cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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" "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ 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" - unfolding 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def + unfolding 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by auto -lemma document_ptr_no_node_ptr_cast [simp]: +lemma document_ptr_no_node_ptr_cast [simp]: "\ is_document_ptr_kind (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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(simp add: cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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_def is_document_ptr_kind_def) -lemma node_ptr_no_document_ptr_cast [simp]: +lemma node_ptr_no_document_ptr_cast [simp]: "\ is_node_ptr_kind (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr)" using is_node_ptr_kind_obtains by fastforce -lemma document_ptr_document_ptr_cast [simp]: +lemma document_ptr_document_ptr_cast [simp]: "is_document_ptr_kind (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)" by (simp add: 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_def 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_def is_document_ptr_kind_def) @@ -116,7 +116,7 @@ lemma document_ptr_casts_commute [simp]: unfolding 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_def 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_def by(auto split: object_ptr.splits sum.splits) -lemma document_ptr_casts_commute2 [simp]: +lemma document_ptr_casts_commute2 [simp]: "(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 (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) = Some document_ptr)" by simp @@ -140,11 +140,11 @@ lemma is_document_ptr_kind_none: unfolding is_document_ptr_kind_def 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_def by (auto split: object_ptr.splits sum.splits) -lemma cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject [simp]: +lemma cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject [simp]: "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 x = cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r y \ x = y" by(simp add: 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_def) -lemma 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_ext_none [simp]: +lemma 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_ext_none [simp]: "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 (object_ptr.Ext (Inr (Inr (Inr object_ext_ptr)))) = None" by(simp add: 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_def) diff --git a/Core_DOM/Core_DOM/common/pointers/ElementPointer.thy b/Core_DOM/Core_DOM/common/pointers/ElementPointer.thy index 99be418..eb0957d 100644 --- a/Core_DOM/Core_DOM/common/pointers/ElementPointer.thy +++ b/Core_DOM/Core_DOM/common/pointers/ElementPointer.thy @@ -23,26 +23,26 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Element\ -text\In this theory, we introduce the typed pointers for the class Element.\ +text\In this theory, we introduce the typed pointers for the class Element.\ theory ElementPointer imports NodePointer begin datatype 'element_ptr element_ptr = Ref (the_ref: ref) | Ext 'element_ptr -register_default_tvars "'element_ptr element_ptr" +register_default_tvars "'element_ptr element_ptr" type_synonym ('node_ptr, 'element_ptr) node_ptr = "('element_ptr element_ptr + 'node_ptr) node_ptr" -register_default_tvars "('node_ptr, 'element_ptr) node_ptr" +register_default_tvars "('node_ptr, 'element_ptr) node_ptr" type_synonym ('object_ptr, 'node_ptr, 'element_ptr) object_ptr = "('object_ptr, 'element_ptr element_ptr + 'node_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr) object_ptr" +register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr) object_ptr" definition 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>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) element_ptr \ (_) element_ptr" @@ -59,16 +59,16 @@ abbreviation cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub> definition cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \ (_) element_ptr option" where - "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr = (case node_ptr of node_ptr.Ext (Inl element_ptr) + "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr = (case node_ptr of node_ptr.Ext (Inl element_ptr) \ Some element_ptr | _ \ None)" abbreviation cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ (_) element_ptr option" where - "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of - Some node_ptr \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr + "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of + Some node_ptr \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr | None \ None)" -adhoc_overloading cast 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 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 +adhoc_overloading cast 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 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 cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^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>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r consts is_element_ptr_kind :: 'a @@ -78,8 +78,8 @@ definition is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\< abbreviation is_element_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" where - "is_element_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some node_ptr \ is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr + "is_element_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some node_ptr \ is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr | None \ False)" adhoc_overloading is_element_ptr_kind is_element_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r @@ -92,14 +92,14 @@ definition is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub> abbreviation is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \ bool" where - "is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some element_ptr \ is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr + "is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some element_ptr \ is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr | _ \ False)" abbreviation is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" where - "is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some node_ptr \ is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr + "is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some node_ptr \ is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr | None \ False)" adhoc_overloading is_element_ptr is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r @@ -116,16 +116,16 @@ adhoc_overloading is_element_ptr_ext is_element_ptr_ext\<^sub>o\<^sub>b\<^sub>j\ instantiation element_ptr :: (linorder) linorder begin -definition +definition less_eq_element_ptr :: "(_::linorder) element_ptr \ (_)element_ptr \ bool" - where + where "less_eq_element_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j | Ref _ \ False) | Ref i \ (case y of Ext _ \ True | Ref j \ i \ j))" -definition +definition less_element_ptr :: "(_::linorder) element_ptr \ (_) element_ptr \ bool" where "less_element_ptr x y \ x \ y \ \ y \ x" -instance - apply(standard) +instance + apply(standard) by(auto simp add: less_eq_element_ptr_def less_element_ptr_def split: element_ptr.splits) end @@ -137,7 +137,7 @@ lemma element_ptr_casts_commute [simp]: unfolding cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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_def by(auto split: node_ptr.splits sum.splits) -lemma element_ptr_casts_commute2 [simp]: +lemma element_ptr_casts_commute2 [simp]: "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr) = Some element_ptr)" by simp @@ -145,7 +145,7 @@ lemma element_ptr_casts_commute3 [simp]: assumes "is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr" shows "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 (the (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) = node_ptr" using assms - by(auto simp add: is_element_ptr_kind_def 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def + by(auto simp add: is_element_ptr_kind_def 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: node_ptr.splits sum.splits) lemma is_element_ptr_kind_obtains: @@ -160,15 +160,15 @@ lemma is_element_ptr_kind_none: unfolding is_element_ptr_kind_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by(auto split: node_ptr.splits sum.splits) -lemma is_element_ptr_kind_cast [simp]: +lemma is_element_ptr_kind_cast [simp]: "is_element_ptr_kind (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 element_ptr)" by (metis element_ptr_casts_commute is_element_ptr_kind_none option.distinct(1)) -lemma 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_inject [simp]: +lemma 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_inject [simp]: "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 x = cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r y \ x = y" by(simp add: 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_def) -lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_ext_none [simp]: +lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_ext_none [simp]: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (node_ptr.Ext (Inr (Inr node_ext_ptr))) = None" by(simp add: cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) diff --git a/Core_DOM/Core_DOM/common/pointers/NodePointer.thy b/Core_DOM/Core_DOM/common/pointers/NodePointer.thy index f3bd2ca..2e58081 100644 --- a/Core_DOM/Core_DOM/common/pointers/NodePointer.thy +++ b/Core_DOM/Core_DOM/common/pointers/NodePointer.thy @@ -23,22 +23,22 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Node\ -text\In this theory, we introduce the typed pointers for the class Node.\ +text\In this theory, we introduce the typed pointers for the class Node.\ theory NodePointer imports ObjectPointer begin datatype 'node_ptr node_ptr = Ext 'node_ptr -register_default_tvars "'node_ptr node_ptr" +register_default_tvars "'node_ptr node_ptr" type_synonym ('object_ptr, 'node_ptr) object_ptr = "('node_ptr node_ptr + 'object_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr) object_ptr" +register_default_tvars "('object_ptr, 'node_ptr) object_ptr" definition cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ (_) object_ptr" where @@ -46,7 +46,7 @@ definition cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\ definition 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 :: "(_) object_ptr \ (_) node_ptr option" where - "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 object_ptr = (case object_ptr of object_ptr.Ext (Inl node_ptr) + "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 object_ptr = (case object_ptr of object_ptr.Ext (Inl node_ptr) \ Some node_ptr | _ \ None)" adhoc_overloading cast cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r @@ -61,17 +61,17 @@ definition less_eq_node_ptr :: "(_::linorder) node_ptr \ (_) node_pt where "less_eq_node_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j))" definition less_node_ptr :: "(_::linorder) node_ptr \ (_) node_ptr \ bool" where "less_node_ptr x y \ x \ y \ \ y \ x" -instance +instance apply(standard) by(auto simp add: less_eq_node_ptr_def less_node_ptr_def split: node_ptr.splits) end -lemma node_ptr_casts_commute [simp]: +lemma node_ptr_casts_commute [simp]: "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 = Some 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" unfolding 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_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by(auto split: object_ptr.splits sum.splits) -lemma node_ptr_casts_commute2 [simp]: +lemma node_ptr_casts_commute2 [simp]: "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 (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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) = Some node_ptr" by simp @@ -79,7 +79,7 @@ lemma node_ptr_casts_commute3 [simp]: assumes "is_node_ptr_kind ptr" shows "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)) = ptr" using assms - by(auto simp add: is_node_ptr_kind_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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_def + by(auto simp add: is_node_ptr_kind_def cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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_def split: object_ptr.splits sum.splits) lemma is_node_ptr_kind_obtains: @@ -97,15 +97,15 @@ lemma is_node_ptr_kind_none: lemma is_node_ptr_kind_cast [simp]: "is_node_ptr_kind (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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)" unfolding is_node_ptr_kind_def by simp -lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 [simp]: +lemma cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 [simp]: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r x = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r y \ x = y" by(simp add: cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) -lemma 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_ext_none [simp]: +lemma 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_ext_none [simp]: "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 (object_ptr.Ext (Inr (Inr (Inr object_ext_ptr)))) = None" by(simp add: 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_def) -lemma node_ptr_inclusion [simp]: +lemma node_ptr_inclusion [simp]: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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_ptrs \ node_ptr \ node_ptrs" by auto end diff --git a/Core_DOM/Core_DOM/common/pointers/ObjectPointer.thy b/Core_DOM/Core_DOM/common/pointers/ObjectPointer.thy index c4168c2..4ec2876 100644 --- a/Core_DOM/Core_DOM/common/pointers/ObjectPointer.thy +++ b/Core_DOM/Core_DOM/common/pointers/ObjectPointer.thy @@ -23,12 +23,12 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Object\ -text\In this theory, we introduce the typed pointer for the class Object. This class is the +text\In this theory, we introduce the typed pointer for the class Object. This class is the common superclass of our class model.\ theory ObjectPointer imports @@ -36,7 +36,7 @@ theory ObjectPointer begin datatype 'object_ptr object_ptr = Ext 'object_ptr -register_default_tvars "'object_ptr object_ptr" +register_default_tvars "'object_ptr object_ptr" instantiation object_ptr :: (linorder) linorder begin @@ -44,7 +44,7 @@ definition less_eq_object_ptr :: "'object_ptr::linorder object_ptr \ where "less_eq_object_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j))" definition less_object_ptr :: "'object_ptr::linorder object_ptr \ 'object_ptr object_ptr \ bool" where "less_object_ptr x y \ x \ y \ \ y \ x" -instance by(standard, auto simp add: less_eq_object_ptr_def less_object_ptr_def +instance by(standard, auto simp add: less_eq_object_ptr_def less_object_ptr_def split: object_ptr.splits) end diff --git a/Core_DOM/Core_DOM/common/pointers/Ref.thy b/Core_DOM/Core_DOM/common/pointers/Ref.thy index fd29f5e..8d16b98 100644 --- a/Core_DOM/Core_DOM/common/pointers/Ref.thy +++ b/Core_DOM/Core_DOM/common/pointers/Ref.thy @@ -23,16 +23,16 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\References\ text\ - This theory, we introduce a generic reference. All our typed pointers include such - a reference, which allows us to distinguish pointers of the same type, but also to + This theory, we introduce a generic reference. All our typed pointers include such + a reference, which allows us to distinguish pointers of the same type, but also to iterate over all pointers in a set.\ -theory +theory Ref imports "HOL-Library.Adhoc_Overloading" diff --git a/Core_DOM/Core_DOM/common/preliminaries/Heap_Error_Monad.thy b/Core_DOM/Core_DOM/common/preliminaries/Heap_Error_Monad.thy index 5a4a0b4..bdf966a 100644 --- a/Core_DOM/Core_DOM/common/preliminaries/Heap_Error_Monad.thy +++ b/Core_DOM/Core_DOM/common/preliminaries/Heap_Error_Monad.thy @@ -23,15 +23,15 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\The Heap Error Monad\ -text \In this theory, we define a heap and error monad for modeling exceptions. -This allows us to define composite methods similar to stateful programming in Haskell, +text \In this theory, we define a heap and error monad for modeling exceptions. +This allows us to define composite methods similar to stateful programming in Haskell, but also to stay close to the official DOM specification.\ -theory +theory Heap_Error_Monad imports Hiding_Type_Variables @@ -45,22 +45,22 @@ register_default_tvars "('heap, 'e, 'result) prog" (print, parse) subsection \Basic Functions\ -definition +definition bind :: "(_, 'result) prog \ ('result \ (_, 'result2) prog) \ (_, 'result2) prog" where - "bind f g = Prog (\h. (case (the_prog f) h of Inr (x, h') \ (the_prog (g x)) h' + "bind f g = Prog (\h. (case (the_prog f) h of Inr (x, h') \ (the_prog (g x)) h' | Inl exception \ Inl exception))" adhoc_overloading Monad_Syntax.bind bind -definition - execute :: "'heap \ ('heap, 'e, 'result) prog \ ('e + 'result \ 'heap)" +definition + execute :: "'heap \ ('heap, 'e, 'result) prog \ ('e + 'result \ 'heap)" ("((_)/ \ (_))" [51, 52] 55) where "execute h p = (the_prog p) h" -definition - returns_result :: "'heap \ ('heap, 'e, 'result) prog \ 'result \ bool" +definition + returns_result :: "'heap \ ('heap, 'e, 'result) prog \ 'result \ bool" ("((_)/ \ (_)/ \\<^sub>r (_))" [60, 35, 61] 65) where "returns_result h p r \ (case h \ p of Inr (r', _) \ r = r' | Inl _ \ False)" @@ -73,8 +73,8 @@ fun select_result ("|(_)|\<^sub>r") lemma returns_result_eq [elim]: "h \ f \\<^sub>r y \ h \ f \\<^sub>r y' \ y = y'" by(auto simp add: returns_result_def split: sum.splits) -definition - returns_heap :: "'heap \ ('heap, 'e, 'result) prog \ 'heap \ bool" +definition + returns_heap :: "'heap \ ('heap, 'e, 'result) prog \ 'heap \ bool" ("((_)/ \ (_)/ \\<^sub>h (_))" [60, 35, 61] 65) where "returns_heap h p h' \ (case h \ p of Inr (_ , h'') \ h' = h'' | Inl _ \ False)" @@ -87,13 +87,14 @@ fun select_heap ("|(_)|\<^sub>h") 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" +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)" +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") @@ -101,8 +102,8 @@ fun select_result_heap ("|(_)|\<^sub>r\<^sub>h") "select_result_heap (Inr (r, h)) = (r, h)" | "select_result_heap (Inl _) = undefined" -definition - returns_error :: "'heap \ ('heap, 'e, 'result) prog \ 'e \ bool" +definition + returns_error :: "'heap \ ('heap, 'e, 'result) prog \ 'e \ bool" ("((_)/ \ (_)/ \\<^sub>e (_))" [60, 35, 61] 65) where "returns_error h p e = (case h \ p of Inr _ \ False | Inl e' \ e = e')" @@ -147,13 +148,13 @@ lemma returns_result_select_result [simp]: by (simp add: select_result_I) lemma select_result_E: - assumes "P |h \ f|\<^sub>r" and "h \ ok f" + assumes "P |h \ f|\<^sub>r" and "h \ ok f" obtains x where "h \ f \\<^sub>r x" and "P x" using assms by(auto simp add: is_OK_def returns_result_def split: sum.splits) lemma select_result_eq: "(\x .h \ f \\<^sub>r x = h' \ f \\<^sub>r x) \ |h \ f|\<^sub>r = |h' \ f|\<^sub>r" - by (metis (no_types, lifting) is_OK_def old.sum.simps(6) select_result.elims + by (metis (no_types, lifting) is_OK_def old.sum.simps(6) select_result.elims select_result_I select_result_I2) definition error :: "'e \ ('heap, 'e, 'result) prog" @@ -252,7 +253,7 @@ lemma pure_returns_heap_eq: "h \ f \\<^sub>h h' \ pure f h \ h = h'" by (meson pure_def is_OK_returns_heap_I returns_heap_eq) -lemma pure_eq_iff: +lemma pure_eq_iff: "(\h' x. h \ f \\<^sub>r x \ h \ f \\<^sub>h h' \ h = h') \ pure f h" by(auto simp add: pure_def) @@ -265,7 +266,7 @@ lemma bind_assoc [simp]: lemma bind_returns_result_E: assumes "h \ f \ g \\<^sub>r y" obtains x h' where "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>r y" - using assms by(auto simp add: bind_def returns_result_def returns_heap_def execute_def + using assms by(auto simp add: bind_def returns_result_def returns_heap_def execute_def split: sum.splits) lemma bind_returns_result_E2: @@ -279,14 +280,14 @@ lemma bind_returns_result_E3: using assms returns_result_eq bind_returns_result_E2 by metis lemma bind_returns_result_E4: - assumes "h \ f \ g \\<^sub>r y" and "h \ f \\<^sub>r x" + assumes "h \ f \ g \\<^sub>r y" and "h \ f \\<^sub>r x" obtains h' where "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>r y" using assms returns_result_eq bind_returns_result_E by metis lemma bind_returns_heap_E: assumes "h \ f \ g \\<^sub>h h''" obtains x h' where "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>h h''" - using assms by(auto simp add: bind_def returns_result_def returns_heap_def execute_def + using assms by(auto simp add: bind_def returns_result_def returns_heap_def execute_def split: sum.splits) lemma bind_returns_heap_E2 [elim]: @@ -295,7 +296,7 @@ lemma bind_returns_heap_E2 [elim]: using assms pure_returns_heap_eq by (fastforce elim: bind_returns_heap_E) lemma bind_returns_heap_E3 [elim]: - assumes "h \ f \ g \\<^sub>h h'" and "h \ f \\<^sub>r x" and "pure f h" + assumes "h \ f \ g \\<^sub>h h'" and "h \ f \\<^sub>r x" and "pure f h" shows "h \ g x \\<^sub>h h'" using assms pure_returns_heap_eq returns_result_eq by (fastforce elim: bind_returns_heap_E) @@ -315,7 +316,7 @@ lemma bind_returns_error_I3: assumes "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>e e" shows "h \ f \ g \\<^sub>e e" using assms - by(auto simp add: returns_error_def bind_def execute_def returns_heap_def returns_result_def + by(auto simp add: returns_error_def bind_def execute_def returns_heap_def returns_result_def split: sum.splits) lemma bind_returns_error_I2 [intro]: @@ -327,22 +328,22 @@ lemma bind_returns_error_I2 [intro]: lemma bind_is_OK_E [elim]: assumes "h \ ok (f \ g)" obtains x h' where "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ ok (g x)" - using assms - by(auto simp add: bind_def returns_result_def returns_heap_def is_OK_def execute_def + using assms + by(auto simp add: bind_def returns_result_def returns_heap_def is_OK_def execute_def split: sum.splits) lemma bind_is_OK_E2: assumes "h \ ok (f \ g)" and "h \ f \\<^sub>r x" obtains h' where "h \ f \\<^sub>h h'" and "h' \ ok (g x)" - using assms - by(auto simp add: bind_def returns_result_def returns_heap_def is_OK_def execute_def + using assms + by(auto simp add: bind_def returns_result_def returns_heap_def is_OK_def execute_def split: sum.splits) lemma bind_returns_result_I [intro]: assumes "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>r y" shows "h \ f \ g \\<^sub>r y" - using assms - by(auto simp add: bind_def returns_result_def returns_heap_def execute_def + using assms + by(auto simp add: bind_def returns_result_def returns_heap_def execute_def split: sum.splits) lemma bind_pure_returns_result_I [intro]: @@ -359,8 +360,8 @@ lemma bind_pure_returns_result_I2 [intro]: lemma bind_returns_heap_I [intro]: assumes "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ g x \\<^sub>h h''" shows "h \ f \ g \\<^sub>h h''" - using assms - by(auto simp add: bind_def returns_result_def returns_heap_def execute_def + using assms + by(auto simp add: bind_def returns_result_def returns_heap_def execute_def split: sum.splits) lemma bind_returns_heap_I2 [intro]: @@ -372,13 +373,13 @@ lemma bind_returns_heap_I2 [intro]: lemma bind_is_OK_I [intro]: assumes "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" and "h' \ ok (g x)" shows "h \ ok (f \ g)" - by (meson assms(1) assms(2) assms(3) bind_returns_heap_I is_OK_returns_heap_E + by (meson assms(1) assms(2) assms(3) bind_returns_heap_I is_OK_returns_heap_E is_OK_returns_heap_I) lemma bind_is_OK_I2 [intro]: assumes "h \ ok f" and "\x h'. h \ f \\<^sub>r x \ h \ f \\<^sub>h h' \ h' \ ok (g x)" shows "h \ ok (f \ g)" - using assms by blast + using assms by blast lemma bind_is_OK_pure_I [intro]: assumes "pure f h" and "h \ ok f" and "\x. h \ f \\<^sub>r x \ h \ ok (g x)" @@ -394,15 +395,15 @@ lemma bind_pure_I: lemma pure_pure: assumes "h \ ok f" and "pure f h" shows "h \ f \\<^sub>h h" - using assms returns_heap_eq + using assms returns_heap_eq unfolding pure_def by auto -lemma bind_returns_error_eq: +lemma bind_returns_error_eq: assumes "h \ f \\<^sub>e e" and "h \ g \\<^sub>e e" shows "h \ f = h \ g" - using assms + using assms by(auto simp add: returns_error_def split: sum.splits) subsection \Map\ @@ -416,7 +417,7 @@ fun map_M :: "('x \ ('heap, 'e, 'result) prog) \ 'x list return (y # ys) }" -lemma map_M_ok_I [intro]: +lemma map_M_ok_I [intro]: "(\x. x \ set xs \ h \ ok (f x)) \ (\x. x \ set xs \ pure (f x) h) \ h \ ok (map_M f xs)" apply(induct xs) by (simp_all add: bind_is_OK_I2 bind_is_OK_pure_I) @@ -452,38 +453,16 @@ fun forall_M :: "('y \ ('heap, 'e, 'result) prog) \ 'y l P x; forall_M P xs }" - (* -lemma forall_M_elim: - assumes "h \ forall_M P xs \\<^sub>r True" and "\x h. x \ set xs \ pure (P x) h" - shows "\x \ set xs. h \ P x \\<^sub>r True" - apply(insert assms, induct xs) - apply(simp) - apply(auto elim!: bind_returns_result_E)[1] - by (metis (full_types) pure_returns_heap_eq) *) lemma pure_forall_M_I: "(\x. x \ set xs \ pure (P x) h) \ pure (forall_M P xs) h" apply(induct xs) by(auto intro!: bind_pure_I) - (* -lemma forall_M_pure_I: - assumes "\x. x \ set xs \ h \ P x \\<^sub>r True" and "\x h. x \ set xs \ pure (P x)h" - shows "h \ forall_M P xs \\<^sub>r True" - apply(insert assms, induct xs) - apply(simp) - by(fastforce) - -lemma forall_M_pure_eq: - assumes "\x. x \ set xs \ h \ P x \\<^sub>r True \ h' \ P x \\<^sub>r True" - and "\x h. x \ set xs \ pure (P x) h" - shows "(h \ forall_M P xs \\<^sub>r True) \ h' \ forall_M P xs \\<^sub>r True" - using assms - by(auto intro!: forall_M_pure_I dest!: forall_M_elim) *) subsection \Fold\ fun fold_M :: "('result \ 'y \ ('heap, 'e, 'result) prog) \ 'result \ 'y list \ ('heap, 'e, 'result) prog" - where + where "fold_M f d [] = return d" | "fold_M f d (x # xs) = do { y \ f d x; fold_M f y xs }" @@ -503,10 +482,11 @@ fun filter_M :: "('x \ ('heap, 'e, bool) prog) \ 'x list }" lemma filter_M_pure_I [intro]: "(\x. x \ set xs \ pure (P x) h) \ pure (filter_M P xs)h" - apply(induct xs) + apply(induct xs) by(auto intro!: bind_pure_I) -lemma filter_M_is_OK_I [intro]: "(\x. x \ set xs \ h \ ok (P x)) \ (\x. x \ set xs \ pure (P x) h) \ h \ ok (filter_M P xs)" +lemma filter_M_is_OK_I [intro]: + "(\x. x \ set xs \ h \ ok (P x)) \ (\x. x \ set xs \ pure (P x) h) \ h \ ok (filter_M P xs)" apply(induct xs) apply(simp) by(auto intro!: bind_is_OK_pure_I) @@ -518,7 +498,8 @@ lemma filter_M_not_more_elements: by(auto elim!: bind_returns_result_E2 split: if_splits intro!: set_ConsD) lemma filter_M_in_result_if_ok: - assumes "h \ filter_M P xs \\<^sub>r ys" and "\h x. x \ set xs \ pure (P x) h" and "x \ set xs" and "h \ P x \\<^sub>r True" + assumes "h \ filter_M P xs \\<^sub>r ys" and "\h x. x \ set xs \ pure (P x) h" and "x \ set xs" and + "h \ P x \\<^sub>r True" shows "x \ set ys" apply(insert assms, induct xs arbitrary: ys) apply(simp) @@ -539,13 +520,13 @@ lemma filter_M_empty_I: apply(induct xs) by(auto intro!: bind_pure_returns_result_I) -lemma filter_M_subset_2: "h \ filter_M P xs \\<^sub>r ys \ h' \ filter_M P xs \\<^sub>r ys' - \ (\x. pure (P x) h) \ (\x. pure (P x) h') - \ (\b. \x \ set xs. h \ P x \\<^sub>r True \ h' \ P x \\<^sub>r b \ b) +lemma filter_M_subset_2: "h \ filter_M P xs \\<^sub>r ys \ h' \ filter_M P xs \\<^sub>r ys' + \ (\x. pure (P x) h) \ (\x. pure (P x) h') + \ (\b. \x \ set xs. h \ P x \\<^sub>r True \ h' \ P x \\<^sub>r b \ b) \ set ys \ set ys'" proof - - assume 1: "h \ filter_M P xs \\<^sub>r ys" and 2: "h' \ filter_M P xs \\<^sub>r ys'" - and 3: "(\x. pure (P x) h)" and "(\x. pure (P x) h')" + assume 1: "h \ filter_M P xs \\<^sub>r ys" and 2: "h' \ filter_M P xs \\<^sub>r ys'" + and 3: "(\x. pure (P x) h)" and "(\x. pure (P x) h')" and 4: "\b. \x\set xs. h \ P x \\<^sub>r True \ h' \ P x \\<^sub>r b \ b" have h1: "\x \ set xs. h' \ ok (P x)" using 2 3 \(\x. pure (P x) h')\ @@ -583,17 +564,17 @@ lemma filter_M_distinct: "h \ filter_M P xs \\<^sub>r ys apply(auto elim!: bind_returns_result_E)[1] by fastforce -lemma filter_M_filter: "h \ filter_M P xs \\<^sub>r ys \ (\x. x \ set xs \ pure (P x) h) +lemma filter_M_filter: "h \ filter_M P xs \\<^sub>r ys \ (\x. x \ set xs \ pure (P x) h) \ (\x \ set xs. h \ ok P x) \ ys = filter (\x. |h \ P x|\<^sub>r) xs" apply(induct xs arbitrary: ys) by(auto elim!: bind_returns_result_E2) -lemma filter_M_filter2: "(\x. x \ set xs \ pure (P x) h \ h \ ok P x) +lemma filter_M_filter2: "(\x. x \ set xs \ pure (P x) h \ h \ ok P x) \ filter (\x. |h \ P x|\<^sub>r) xs = ys \ h \ filter_M P xs \\<^sub>r ys" apply(induct xs arbitrary: ys) by(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I) -lemma filter_ex1: "\!x \ set xs. P x \ P x \ x \ set xs \ distinct xs +lemma filter_ex1: "\!x \ set xs. P x \ P x \ x \ set xs \ distinct xs \ filter P xs = [x]" apply(auto)[1] apply(induct xs) @@ -612,16 +593,16 @@ lemma filter_M_ex1: proof - have *: "\!x \ set xs. |h \ P x|\<^sub>r" apply(insert assms(1) assms(3) assms(4)) - apply(drule filter_M_filter) + apply(drule filter_M_filter) apply(simp) apply(auto simp add: select_result_I2)[1] by (metis (full_types) is_OK_returns_result_E select_result_I2) then show ?thesis apply(insert assms(1) assms(4)) apply(drule filter_M_filter) - apply(auto)[1] - by (metis * assms(2) assms(5) assms(6) distinct_filter - distinct_length_2_or_more filter_empty_conv filter_set list.exhaust + apply(auto)[1] + by (metis * assms(2) assms(5) assms(6) distinct_filter + distinct_length_2_or_more filter_empty_conv filter_set list.exhaust list.set_intros(1) list.set_intros(2) member_filter select_result_I2) qed @@ -631,7 +612,7 @@ lemma filter_M_eq: shows "h \ filter_M P xs \\<^sub>r ys \ h' \ filter_M P xs \\<^sub>r ys" using assms apply (induct xs arbitrary: ys) - by(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I + by(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I dest: returns_result_eq) @@ -696,8 +677,8 @@ subsection\Miscellaneous Rules\ lemma execute_bind_simp: assumes "h \ f \\<^sub>r x" and "h \ f \\<^sub>h h'" shows "h \ f \ g = h' \ g x" - using assms - by(auto simp add: returns_result_def returns_heap_def bind_def execute_def + using assms + by(auto simp add: returns_result_def returns_heap_def bind_def execute_def split: sum.splits) lemma bind_cong [fundef_cong]: @@ -706,8 +687,8 @@ lemma bind_cong [fundef_cong]: assumes "h \ f1 = h \ f2" and "\y h'. h \ f1 \\<^sub>r y \ h \ f1 \\<^sub>h h' \ h' \ g1 y = h' \ g2 y" shows "h \ (f1 \ g1) = h \ (f2 \ g2)" - apply(insert assms, cases "h \ f1") - by(auto simp add: bind_def returns_result_def returns_heap_def execute_def + apply(insert assms, cases "h \ f1") + by(auto simp add: bind_def returns_result_def returns_heap_def execute_def split: sum.splits) lemma bind_cong_2: @@ -730,7 +711,8 @@ 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)))" +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 @@ -741,17 +723,17 @@ lemma transp_preserved_f [simp]: "transp (preserved f)" by(auto simp add: preserved_def transp_def) -definition +definition all_args :: "('a \ ('heap, 'e, 'result) prog) \ ('heap, 'e, 'result) prog set" where "all_args f = (\arg. {f arg})" -definition - reads :: "('heap \ 'heap \ bool) set \ ('heap, 'e, 'result) prog \ 'heap +definition + reads :: "('heap \ 'heap \ bool) set \ ('heap, 'e, 'result) prog \ 'heap \ 'heap \ bool" where - "reads S getter h h' \ (\P \ S. reflp P \ transp P) \ ((\P \ S. P h h') + "reads S getter h h' \ (\P \ S. reflp P \ transp P) \ ((\P \ S. P h h') \ preserved getter h h')" lemma reads_singleton [simp]: "reads {preserved f} f h h'" @@ -763,18 +745,21 @@ lemma reads_bind_pure: and "\x. h \ f \\<^sub>r x \ reads S (g x) h h'" shows "reads S (f \ g) h h'" using assms - by(auto simp add: reads_def pure_pure preserved_def - intro!: bind_pure_returns_result_I is_OK_returns_result_I - dest: pure_returns_heap_eq + by(auto simp add: reads_def pure_pure preserved_def + intro!: bind_pure_returns_result_I is_OK_returns_result_I + dest: pure_returns_heap_eq elim!: bind_returns_result_E) -lemma reads_insert_writes_set_left: "\P \ S. reflp P \ transp P \ reads {getter} f h h' \ reads (insert getter S) f h h'" +lemma reads_insert_writes_set_left: + "\P \ S. reflp P \ transp P \ reads {getter} f h h' \ reads (insert getter S) f h h'" unfolding reads_def by simp -lemma reads_insert_writes_set_right: "reflp getter \ transp getter \ reads S f h h' \ reads (insert getter S) f h h'" +lemma reads_insert_writes_set_right: + "reflp getter \ transp getter \ reads S f h h' \ reads (insert getter S) f h h'" unfolding reads_def by blast -lemma reads_subset: "reads S f h h' \ \P \ S' - S. reflp P \ transp P \ S \ S' \ reads S' f h h'" +lemma reads_subset: + "reads S f h h' \ \P \ S' - S. reflp P \ transp P \ S \ S' \ reads S' f h h'" by(auto simp add: reads_def) lemma return_reads [simp]: "reads {} (return x) h h'" @@ -795,10 +780,10 @@ lemma filter_M_reads: apply(induct xs) by(auto intro: reads_subset[OF return_reads] intro!: reads_bind_pure) -definition writes :: +definition writes :: "('heap, 'e, 'result) prog set \ ('heap, 'e, 'result2) prog \ 'heap \ 'heap \ bool" - where - "writes S setter h h' + where + "writes S setter h h' \ (h \ setter \\<^sub>h h' \ (\progs. set progs \ S \ h \ iterate_M progs \\<^sub>h h'))" lemma writes_singleton [simp]: "writes (all_args f) (f a) h h'" @@ -847,7 +832,7 @@ lemma writes_pure [simp]: by (metis bot.extremum iterate_M.simps(1) list.set(1) pure_returns_heap_eq return_returns_heap) lemma writes_bind: - assumes "\h2. writes S f h h2" + assumes "\h2. writes S f h h2" assumes "\x h2. h \ f \\<^sub>r x \ h \ f \\<^sub>h h2 \ writes S (g x) h2 h'" shows "writes S (f \ g) h h'" using assms diff --git a/Core_DOM/Core_DOM/common/preliminaries/Hiding_Type_Variables.thy b/Core_DOM/Core_DOM/common/preliminaries/Hiding_Type_Variables.thy index 3c593ef..8369b99 100644 --- a/Core_DOM/Core_DOM/common/preliminaries/Hiding_Type_Variables.thy +++ b/Core_DOM/Core_DOM/common/preliminaries/Hiding_Type_Variables.thy @@ -26,26 +26,26 @@ * * SPDX-License-Identifier: BSD-2-Clause * Repository: https://git.logicalhacking.com/adbrucker/isabelle-hacks/ - * Dependencies: None (assert.thy is used for testing the theory but it is + * Dependencies: None (assert.thy is used for testing the theory but it is * not required for providing the functionality of this hack) ***********************************************************************************) -(* - This file is based on commit 8a5e95421521c36ab71ab2711435a9bc0fa2c5cc from upstream - (https://git.logicalhacking.com/adbrucker/isabelle-hacks/). Merely the dependency to - Assert.thy has been removed by disabling the example section (which include assert +(* + This file is based on commit 8a5e95421521c36ab71ab2711435a9bc0fa2c5cc from upstream + (https://git.logicalhacking.com/adbrucker/isabelle-hacks/). Merely the dependency to + Assert.thy has been removed by disabling the example section (which include assert checks). *) section\Hiding Type Variables\ -text\ This theory\footnote{This theory can be used ``stand-alone,'' i.e., this theory is +text\ This theory\footnote{This theory can be used ``stand-alone,'' i.e., this theory is not specific to the DOM formalization. The latest version is part of the ``Isabelle Hacks'' - repository: \url{https://git.logicalhacking.com/adbrucker/isabelle-hacks/}.} implements - a mechanism for declaring default type variables for data types. This comes handy for complex + repository: \url{https://git.logicalhacking.com/adbrucker/isabelle-hacks/}.} implements + a mechanism for declaring default type variables for data types. This comes handy for complex data types with many type variables.\ theory "Hiding_Type_Variables" -imports +imports Main keywords "register_default_tvars" @@ -58,40 +58,40 @@ ML\ signature HIDE_TVAR = sig datatype print_mode = print_all | print | noprint datatype tvar_subst = right | left - datatype parse_mode = parse | noparse + datatype parse_mode = parse | noparse type hide_varT = { name: string, tvars: typ list, - typ_syn_tab : (string * typ list*string) Symtab.table, + typ_syn_tab : (string * typ list*string) Symtab.table, print_mode: print_mode, parse_mode: parse_mode - } + } val parse_print_mode : string -> print_mode val parse_parse_mode : string -> parse_mode - val register : string -> print_mode option -> parse_mode option -> + val register : string -> print_mode option -> parse_mode option -> theory -> theory val update_mode : string -> print_mode option -> parse_mode option -> theory -> theory val lookup : theory -> string -> hide_varT option - val hide_tvar_tr' : string -> Proof.context -> term list -> term + val hide_tvar_tr' : string -> Proof.context -> term list -> term val hide_tvar_ast_tr : Proof.context -> Ast.ast list -> Ast.ast - val hide_tvar_subst_ast_tr : tvar_subst -> Proof.context -> Ast.ast list + val hide_tvar_subst_ast_tr : tvar_subst -> Proof.context -> Ast.ast list -> Ast.ast - val hide_tvar_subst_return_ast_tr : tvar_subst -> Proof.context + val hide_tvar_subst_return_ast_tr : tvar_subst -> Proof.context -> Ast.ast list -> Ast.ast end structure Hide_Tvar : HIDE_TVAR = struct datatype print_mode = print_all | print | noprint datatype tvar_subst = right | left - datatype parse_mode = parse | noparse + datatype parse_mode = parse | noparse type hide_varT = { name: string, tvars: typ list, - typ_syn_tab : (string * typ list*string) Symtab.table, + typ_syn_tab : (string * typ list*string) Symtab.table, print_mode: print_mode, parse_mode: parse_mode - } + } type hide_tvar_tab = (hide_varT) Symtab.table fun hide_tvar_eq (a, a') = (#name a) = (#name a') fun merge_tvar_tab (tab,tab') = Symtab.merge hide_tvar_eq (tab,tab') @@ -109,27 +109,27 @@ structure Hide_Tvar : HIDE_TVAR = struct | parse_print_mode "print" = print | parse_print_mode "noprint" = noprint | parse_print_mode s = error("Print mode not supported: "^s) - + fun parse_parse_mode "parse" = parse | parse_parse_mode "noparse" = noparse | parse_parse_mode s = error("Parse mode not supported: "^s) fun update_mode typ_str print_mode parse_mode thy = - let + let val ctx = Toplevel.context_of(Toplevel.theory_toplevel thy) val typ = Syntax.parse_typ ctx typ_str (* no type checking *) - val name = case typ of + val name = case typ of Type(name,_) => name | _ => error("Complex type not (yet) supported.") fun update tab = - let - val old_entry = (case Symtab.lookup tab name of - SOME t => t + let + val old_entry = (case Symtab.lookup tab name of + SOME t => t | NONE => error ("Type shorthand not registered: "^name)) val print_m = case print_mode of SOME m => m | NONE => #print_mode old_entry - val parse_m = case parse_mode of + val parse_m = case parse_mode of SOME m => m | NONE => #parse_mode old_entry val entry = { @@ -139,48 +139,48 @@ structure Hide_Tvar : HIDE_TVAR = struct print_mode = print_m, parse_mode = parse_m } - in + in Symtab.update (name,entry) tab end - in + in Context.theory_of ( (Data.map update) (Context.Theory thy)) end fun lookup thy name = let val tab = (Data.get o Context.Theory) thy - in + in Symtab.lookup tab name end - fun obtain_normalized_vname lookup_table vname = + fun obtain_normalized_vname lookup_table vname = case List.find (fn e => fst e = vname) lookup_table of SOME (_,idx) => (lookup_table, Int.toString idx) - | NONE => let - fun max_idx [] = 0 + | NONE => let + fun max_idx [] = 0 | max_idx ((_,idx)::lt) = Int.max(idx,max_idx lt) - + val idx = (max_idx lookup_table ) + 1 in ((vname,idx)::lookup_table, Int.toString idx) end - + fun normalize_typvar_type lt (Type (a, Ts)) = - let + let fun switch (a,b) = (b,a) val (Ts', lt') = fold_map (fn t => fn lt => switch (normalize_typvar_type lt t)) Ts lt - in + in (lt', Type (a, Ts')) end - | normalize_typvar_type lt (TFree (vname, S)) = - let + | normalize_typvar_type lt (TFree (vname, S)) = + let val (lt, vname) = obtain_normalized_vname lt (vname) - in + in (lt, TFree( vname, S)) end - | normalize_typvar_type lt (TVar (xi, S)) = - let + | normalize_typvar_type lt (TVar (xi, S)) = + let val (lt, vname) = obtain_normalized_vname lt (Term.string_of_vname xi) - in + in (lt, TFree( vname, S)) end @@ -195,26 +195,26 @@ structure Hide_Tvar : HIDE_TVAR = struct fun normalize_typvar_term lt (Const (a, t)) = (lt, Const(a, t)) - | normalize_typvar_term lt (Free (a, t)) = let + | normalize_typvar_term lt (Free (a, t)) = let val (lt, vname) = obtain_normalized_vname lt a in (lt, Free(vname,t)) end | normalize_typvar_term lt (Var (xi, t)) = - let + let val (lt, vname) = obtain_normalized_vname lt (Term.string_of_vname xi) in (lt, Free(vname,t)) end - | normalize_typvar_term lt (Bound (i)) = (lt, Bound(i)) - | normalize_typvar_term lt (Abs(s,ty,tr)) = - let + | normalize_typvar_term lt (Bound (i)) = (lt, Bound(i)) + | normalize_typvar_term lt (Abs(s,ty,tr)) = + let val (lt,tr) = normalize_typvar_term lt tr in (lt, Abs(s,ty,tr)) end | normalize_typvar_term lt (t1$t2) = - let + let val (lt,t1) = normalize_typvar_term lt t1 val (lt,t2) = normalize_typvar_term lt t2 in @@ -222,78 +222,78 @@ structure Hide_Tvar : HIDE_TVAR = struct end - fun normalize_typvar_term' t = snd(normalize_typvar_term [] t) + fun normalize_typvar_term' t = snd(normalize_typvar_term [] t) fun key_of_term (Const(s,_)) = if String.isPrefix "\<^type>" s then Lexicon.unmark_type s else "" | key_of_term (Free(s,_)) = s - | key_of_term (Var(xi,_)) = Term.string_of_vname xi + | key_of_term (Var(xi,_)) = Term.string_of_vname xi | key_of_term (Bound(_)) = error("Bound() not supported in key_of_term") | key_of_term (Abs(_,_,_)) = error("Abs() not supported in key_of_term") | key_of_term (t1$t2) = (key_of_term t1)^(key_of_term t2) val key_of_term' = key_of_term o normalize_typvar_term' - + fun hide_tvar_tr' tname ctx terms = let - val mtyp = Syntax.parse_typ ctx tname (* no type checking *) + val mtyp = Syntax.parse_typ ctx tname (* no type checking *) val (fq_name, _) = case mtyp of Type(s,ts) => (s,ts) - | _ => error("Complex type not (yet) supported.") + | _ => error("Complex type not (yet) supported.") val local_name_of = hd o rev o String.fields (fn c => c = #".") - fun hide_type tname = Syntax.const("(_) "^tname) - + fun hide_type tname = Syntax.const("(_) "^tname) + val reg_type_as_term = Term.list_comb(Const(Lexicon.mark_type tname,dummyT),terms) val key = key_of_term' reg_type_as_term val actual_tvars_key = key_of_term reg_type_as_term in - case lookup (Proof_Context.theory_of ctx) fq_name of + case lookup (Proof_Context.theory_of ctx) fq_name of NONE => raise Match | SOME e => let - val (tname,default_tvars_key) = + val (tname,default_tvars_key) = case Symtab.lookup (#typ_syn_tab e) key of NONE => (local_name_of tname, "") | SOME (s,_,tv) => (local_name_of s,tv) - in + in case (#print_mode e) of print_all => hide_type tname | print => if default_tvars_key=actual_tvars_key then hide_type tname else raise Match | noprint => raise Match - end + end end - - fun hide_tvar_ast_tr ctx ast= - let + + fun hide_tvar_ast_tr ctx ast= + let val thy = Proof_Context.theory_of ctx fun parse_ast ((Ast.Constant const)::[]) = (const,NONE) - | parse_ast ((Ast.Constant sort)::(Ast.Constant const)::[]) - = (const,SOME sort) - | parse_ast _ = error("AST type not supported.") + | parse_ast ((Ast.Constant sort)::(Ast.Constant const)::[]) + = (const,SOME sort) + | parse_ast _ = error("AST type not supported.") - val (decorated_name, decorated_sort) = parse_ast ast + val (decorated_name, decorated_sort) = parse_ast ast val name = Lexicon.unmark_type decorated_name - val default_info = case lookup thy name of + val default_info = case lookup thy name of NONE => error("No default type vars registered: "^name) | SOME e => e - val _ = if #parse_mode default_info = noparse + val _ = if #parse_mode default_info = noparse then error("Default type vars disabled (option noparse): "^name) else () - fun name_of_tvar tvar = case tvar of (TFree(n,_)) => n + fun name_of_tvar tvar = case tvar of (TFree(n,_)) => n | _ => error("Unsupported type structure.") - val type_vars_ast = - let fun mk_tvar n = - case decorated_sort of + val type_vars_ast = + let fun mk_tvar n = + case decorated_sort of NONE => Ast.Variable(name_of_tvar n) | SOME sort => Ast.Appl([Ast.Constant("_ofsort"), Ast.Variable(name_of_tvar n), @@ -303,15 +303,15 @@ structure Hide_Tvar : HIDE_TVAR = struct end in Ast.Appl ((Ast.Constant decorated_name)::type_vars_ast) - end + end fun register typ_str print_mode parse_mode thy = - let + let val ctx = Toplevel.context_of(Toplevel.theory_toplevel thy) val typ = Syntax.parse_typ ctx typ_str val (name,tvars) = case typ of Type(name,tvars) => (name,tvars) | _ => error("Unsupported type structure.") - + val base_typ = Syntax.read_typ ctx typ_str val (base_name,base_tvars) = case base_typ of Type(name,tvars) => (name,tvars) | _ => error("Unsupported type structure.") @@ -319,10 +319,10 @@ structure Hide_Tvar : HIDE_TVAR = struct val base_key = key_of_type' base_typ val base_tvar_key = key_of_type base_typ - val print_m = case print_mode of + val print_m = case print_mode of SOME m => m | NONE => print_all - val parse_m = case parse_mode of + val parse_m = case parse_mode of SOME m => m | NONE => parse val entry = { @@ -333,8 +333,8 @@ structure Hide_Tvar : HIDE_TVAR = struct parse_mode = parse_m } - val base_entry = if name = base_name - then + val base_entry = if name = base_name + then { name = "", tvars = [], @@ -342,7 +342,7 @@ structure Hide_Tvar : HIDE_TVAR = struct print_mode = noprint, parse_mode = noparse } - else case lookup thy base_name of + else case lookup thy base_name of SOME e => e | NONE => error ("No entry found for "^base_name^ " (via "^name^")") @@ -351,15 +351,15 @@ structure Hide_Tvar : HIDE_TVAR = struct name = #name base_entry, tvars = #tvars base_entry, typ_syn_tab = Symtab.update (base_key, (name, base_tvars, base_tvar_key)) - (#typ_syn_tab (base_entry)), + (#typ_syn_tab (base_entry)), print_mode = #print_mode base_entry, parse_mode = #parse_mode base_entry } - fun reg tab = let + fun reg tab = let val tab = Symtab.update_new(name, entry) tab - val tab = if name = base_name - then tab + val tab = if name = base_name + then tab else Symtab.update(base_name, base_entry) tab in tab @@ -368,13 +368,13 @@ structure Hide_Tvar : HIDE_TVAR = struct val thy = Sign.print_translation [(Lexicon.mark_type name, hide_tvar_tr' name)] thy - in + in Context.theory_of ( (Data.map reg) (Context.Theory thy)) handle Symtab.DUP _ => error("Type shorthand already registered: "^name) end fun hide_tvar_subst_ast_tr hole ctx (ast::[]) = - let + let val thy = Proof_Context.theory_of ctx val (decorated_name, args) = case ast @@ -385,23 +385,23 @@ structure Hide_Tvar : HIDE_TVAR = struct val default_info = case lookup thy name of NONE => error("No default type vars registered: "^name) | SOME e => e - val _ = if #parse_mode default_info = noparse + val _ = if #parse_mode default_info = noparse then error("Default type vars disabled (option noparse): "^name) else () - fun name_of_tvar tvar = case tvar of (TFree(n,_)) => n + fun name_of_tvar tvar = case tvar of (TFree(n,_)) => n | _ => error("Unsupported type structure.") val type_vars_ast = map (fn n => Ast.Variable(name_of_tvar n)) (#tvars default_info) - val type_vars_ast = case hole of + val type_vars_ast = case hole of right => (List.rev(List.drop(List.rev type_vars_ast, List.length args)))@args | left => args@List.drop(type_vars_ast, List.length args) in Ast.Appl ((Ast.Constant decorated_name)::type_vars_ast) - end + end | hide_tvar_subst_ast_tr _ _ _ = error("hide_tvar_subst_ast_tr: empty AST.") - fun hide_tvar_subst_return_ast_tr hole ctx (retval::constructor::[]) = + fun hide_tvar_subst_return_ast_tr hole ctx (retval::constructor::[]) = hide_tvar_subst_ast_tr hole ctx [Ast.Appl (constructor::retval::[])] - | hide_tvar_subst_return_ast_tr _ _ _ = + | hide_tvar_subst_return_ast_tr _ _ _ = error("hide_tvar_subst_return_ast_tr: error in parsing AST") @@ -411,7 +411,7 @@ end subsection\Register Parse Translations\ -syntax "_tvars_wildcard" :: "type \ type" ("'('_') _") +syntax "_tvars_wildcard" :: "type \ type" ("'('_') _") syntax "_tvars_wildcard_retval" :: "type \ type \ type" ("'('_, _') _") syntax "_tvars_wildcard_sort" :: "sort \ type \ type" ("'('_::_') _") syntax "_tvars_wildcard_right" :: "type \ type" ("_ '_..") @@ -431,42 +431,42 @@ subsection\Register Top-Level Isar Commands\ ML\ val modeP = (Parse.$$$ "(" |-- (Parse.name --| Parse.$$$ "," - -- Parse.name --| + -- Parse.name --| Parse.$$$ ")")) val typ_modeP = Parse.typ -- (Scan.optional modeP ("print_all","parse")) val _ = Outer_Syntax.command @{command_keyword "register_default_tvars"} "Register default variables (and hiding mechanims) for a type." - (typ_modeP >> (fn (typ,(print_m,parse_m)) => - (Toplevel.theory - (Hide_Tvar.register typ - (SOME (Hide_Tvar.parse_print_mode print_m)) - (SOME (Hide_Tvar.parse_parse_mode parse_m)))))); + (typ_modeP >> (fn (typ,(print_m,parse_m)) => + (Toplevel.theory + (Hide_Tvar.register typ + (SOME (Hide_Tvar.parse_print_mode print_m)) + (SOME (Hide_Tvar.parse_parse_mode parse_m)))))); val _ = Outer_Syntax.command @{command_keyword "update_default_tvars_mode"} "Update print and/or parse mode or the default type variables for a certain type." - (typ_modeP >> (fn (typ,(print_m,parse_m)) => - (Toplevel.theory - (Hide_Tvar.update_mode typ - (SOME (Hide_Tvar.parse_print_mode print_m)) - (SOME (Hide_Tvar.parse_parse_mode parse_m)))))); + (typ_modeP >> (fn (typ,(print_m,parse_m)) => + (Toplevel.theory + (Hide_Tvar.update_mode typ + (SOME (Hide_Tvar.parse_print_mode print_m)) + (SOME (Hide_Tvar.parse_parse_mode parse_m)))))); \ (* section\Examples\ subsection\Print Translation\ -datatype ('a, 'b) hide_tvar_foobar = hide_tvar_foo 'a | hide_tvar_bar 'b +datatype ('a, 'b) hide_tvar_foobar = hide_tvar_foo 'a | hide_tvar_bar 'b type_synonym ('a, 'b, 'c, 'd) hide_tvar_baz = "('a+'b, 'a \ 'b) hide_tvar_foobar" -definition hide_tvar_f::"('a, 'b) hide_tvar_foobar \ ('a, 'b) hide_tvar_foobar \ ('a, 'b) hide_tvar_foobar" +definition hide_tvar_f::"('a, 'b) hide_tvar_foobar \ ('a, 'b) hide_tvar_foobar \ ('a, 'b) hide_tvar_foobar" where "hide_tvar_f a b = a" -definition hide_tvar_g::"('a, 'b, 'c, 'd) hide_tvar_baz \ ('a, 'b, 'c, 'd) hide_tvar_baz \ ('a, 'b, 'c, 'd) hide_tvar_baz" +definition hide_tvar_g::"('a, 'b, 'c, 'd) hide_tvar_baz \ ('a, 'b, 'c, 'd) hide_tvar_baz \ ('a, 'b, 'c, 'd) hide_tvar_baz" where "hide_tvar_g a b = a" assert[string_of_thm_equal, - thm_def="hide_tvar_f_def", + thm_def="hide_tvar_f_def", str="hide_tvar_f (a::('a, 'b) hide_tvar_foobar) (b::('a, 'b) hide_tvar_foobar) = a"] assert[string_of_thm_equal, - thm_def="hide_tvar_g_def", + thm_def="hide_tvar_g_def", str="hide_tvar_g (a::('a + 'b, 'a \ 'b) hide_tvar_foobar) (b::('a + 'b, 'a \ 'b) hide_tvar_foobar) = a"] register_default_tvars "('alpha, 'beta) hide_tvar_foobar" (print_all,parse) @@ -477,7 +477,7 @@ assert[string_of_thm_equal, thm_def="hide_tvar_f_def", str="hide_tvar_f (a::('a, 'b) hide_tvar_foobar) (b::('a, 'b) hide_tvar_foobar) = a"] assert[string_of_thm_equal, - thm_def="hide_tvar_g_def", + thm_def="hide_tvar_g_def", str="hide_tvar_g (a::('a + 'b, 'a \ 'b) hide_tvar_foobar) (b::('a + 'b, 'a \ 'b) hide_tvar_foobar) = a"] update_default_tvars_mode "_ hide_tvar_foobar" (print_all,noparse) @@ -501,29 +501,29 @@ definition hide_tvar_A' :: "'x \ (('x,'b) hide_tvar_foobar) .._" assert[string_of_thm_equal, thm_def="hide_tvar_A'_def", str="hide_tvar_A' (x::'x) = hide_tvar_foo x"] -definition hide_tvar_B' :: "(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" +definition hide_tvar_B' :: "(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" where "hide_tvar_B' x y = x" assert[string_of_thm_equal, thm_def="hide_tvar_A'_def", str="hide_tvar_A' (x::'x) = hide_tvar_foo x"] -definition hide_tvar_B :: "(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" +definition hide_tvar_B :: "(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" where "hide_tvar_B x y = x" assert[string_of_thm_equal, thm_def="hide_tvar_B_def", str="hide_tvar_B (x::(_) hide_tvar_foobar) (y::(_) hide_tvar_foobar) = x"] -definition hide_tvar_C :: "(_) hide_tvar_baz \ (_) hide_tvar_foobar \ (_) hide_tvar_baz" +definition hide_tvar_C :: "(_) hide_tvar_baz \ (_) hide_tvar_foobar \ (_) hide_tvar_baz" where "hide_tvar_C x y = x" assert[string_of_thm_equal, thm_def="hide_tvar_C_def", str="hide_tvar_C (x::(_) hide_tvar_baz) (y::(_) hide_tvar_foobar) = x"] -definition hide_tvar_E :: "(_::linorder) hide_tvar_baz \ (_::linorder) hide_tvar_foobar \ (_::linorder) hide_tvar_baz" +definition hide_tvar_E :: "(_::linorder) hide_tvar_baz \ (_::linorder) hide_tvar_foobar \ (_::linorder) hide_tvar_baz" where "hide_tvar_E x y = x" assert[string_of_thm_equal, thm_def="hide_tvar_C_def", str="hide_tvar_C (x::(_) hide_tvar_baz) (y::(_) hide_tvar_foobar) = x"] -definition hide_tvar_X :: "(_, 'retval::linorder) hide_tvar_baz - \ (_,'retval) hide_tvar_foobar +definition hide_tvar_X :: "(_, 'retval::linorder) hide_tvar_baz + \ (_,'retval) hide_tvar_foobar \ (_,'retval) hide_tvar_baz" where "hide_tvar_X x y = x" *) @@ -531,52 +531,52 @@ definition hide_tvar_X :: "(_, 'retval::linorder) hide_tvar_baz subsection\Introduction\ text\ - When modelling object-oriented data models in HOL with the goal of preserving \<^emph>\extensibility\ - (e.g., as described in~\cite{brucker.ea:extensible:2008-b,brucker:interactive:2007}) one needs + When modelling object-oriented data models in HOL with the goal of preserving \<^emph>\extensibility\ + (e.g., as described in~\cite{brucker.ea:extensible:2008-b,brucker:interactive:2007}) one needs to define type constructors with a large number of type variables. This can reduce the readability - of the overall formalization. Thus, we use a short-hand notation in cases were the names of - the type variables are known from the context. In more detail, this theory sets up both - configurable print and parse translations that allows for replacing @{emph \all\} type variables - by \(_)\, e.g., a five-ary constructor \('a, 'b, 'c, 'd, 'e) hide_tvar_foo\ can - be shorted to \(_) hide_tvar_foo\. The use of this shorthand in output (printing) and - input (parsing) is, on a per-type basis, user-configurable using the top-level commands - \register_default_tvars\ (for registering the names of the default type variables and - the print/parse mode) and \update_default_tvars_mode\ (for changing the print/parse mode - dynamically). + of the overall formalization. Thus, we use a short-hand notation in cases were the names of + the type variables are known from the context. In more detail, this theory sets up both + configurable print and parse translations that allows for replacing @{emph \all\} type variables + by \(_)\, e.g., a five-ary constructor \('a, 'b, 'c, 'd, 'e) hide_tvar_foo\ can + be shorted to \(_) hide_tvar_foo\. The use of this shorthand in output (printing) and + input (parsing) is, on a per-type basis, user-configurable using the top-level commands + \register_default_tvars\ (for registering the names of the default type variables and + the print/parse mode) and \update_default_tvars_mode\ (for changing the print/parse mode + dynamically). - The input also supports short-hands for declaring default sorts (e.g., \(_::linorder)\ - specifies that all default variables need to be instances of the sort (type class) - @{class \linorder\} and short-hands of overriding a suffice (or prefix) of the default type - variables. For example, \('state) hide_tvar_foo _.\ is a short-hand for - \('a, 'b, 'c, 'd, 'state) hide_tvar_foo\. In this document, we omit the implementation - details (we refer the interested reader to theory file) and continue directly with a few - examples. + The input also supports short-hands for declaring default sorts (e.g., \(_::linorder)\ + specifies that all default variables need to be instances of the sort (type class) + @{class \linorder\} and short-hands of overriding a suffice (or prefix) of the default type + variables. For example, \('state) hide_tvar_foo _.\ is a short-hand for + \('a, 'b, 'c, 'd, 'state) hide_tvar_foo\. In this document, we omit the implementation + details (we refer the interested reader to theory file) and continue directly with a few + examples. \ subsection\Example\ text\Given the following type definition:\ -datatype ('a, 'b) hide_tvar_foobar = hide_tvar_foo 'a | hide_tvar_bar 'b +datatype ('a, 'b) hide_tvar_foobar = hide_tvar_foo 'a | hide_tvar_bar 'b type_synonym ('a, 'b, 'c, 'd) hide_tvar_baz = "('a+'b, 'a \ 'b) hide_tvar_foobar" text\We can register default values for the type variables for the abstract -data type as well as the type synonym:\ +data type as well as the type synonym:\ register_default_tvars "('alpha, 'beta) hide_tvar_foobar" (print_all,parse) register_default_tvars "('alpha, 'beta, 'gamma, 'delta) hide_tvar_baz" (print_all,parse) text\This allows us to write\ -definition hide_tvar_f::"(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" +definition hide_tvar_f::"(_) hide_tvar_foobar \ (_) hide_tvar_foobar \ (_) hide_tvar_foobar" where "hide_tvar_f a b = a" -definition hide_tvar_g::"(_) hide_tvar_baz \ (_) hide_tvar_baz \ (_) hide_tvar_baz" +definition hide_tvar_g::"(_) hide_tvar_baz \ (_) hide_tvar_baz \ (_) hide_tvar_baz" where "hide_tvar_g a b = a" text\Instead of specifying the type variables explicitely. This makes, in particular -for type constructors with a large number of type variables, definitions much -more concise. This syntax is also used in the output of antiquotations, e.g., -@{term[show_types] "x = hide_tvar_g"}. Both the print translation and the parse +for type constructors with a large number of type variables, definitions much +more concise. This syntax is also used in the output of antiquotations, e.g., +@{term[show_types] "x = hide_tvar_g"}. Both the print translation and the parse translation can be disabled for each type individually:\ update_default_tvars_mode "_ hide_tvar_foobar" (noprint,noparse) update_default_tvars_mode "_ hide_tvar_foobar" (noprint,noparse) -text\ Now, Isabelle's interactive output and the antiquotations will show +text\ Now, Isabelle's interactive output and the antiquotations will show all type variables, e.g., @{term[show_types] "x = hide_tvar_g"}.\ diff --git a/Core_DOM/Core_DOM/common/preliminaries/Testing_Utils.thy b/Core_DOM/Core_DOM/common/preliminaries/Testing_Utils.thy index a8811e7..ce536f8 100644 --- a/Core_DOM/Core_DOM/common/preliminaries/Testing_Utils.thy +++ b/Core_DOM/Core_DOM/common/preliminaries/Testing_Utils.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -31,10 +31,10 @@ theory Testing_Utils imports Main begin ML \ -val _ = Theory.setup +val _ = Theory.setup (Method.setup @{binding timed_code_simp} (Scan.succeed (SIMPLE_METHOD' o (CHANGED_PROP oo (fn a => fn b => fn tac => - let + let val start = Time.now (); val result = Code_Simp.dynamic_tac a b tac; val t = Time.now() - start; @@ -75,10 +75,12 @@ val _ = Theory.setup 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 (); + 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 ()) + 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))) diff --git a/Core_DOM/Core_DOM/common/tests/Core_DOM_BaseTest.thy b/Core_DOM/Core_DOM/common/tests/Core_DOM_BaseTest.thy index 46127dc..599b293 100644 --- a/Core_DOM/Core_DOM/common/tests/Core_DOM_BaseTest.thy +++ b/Core_DOM/Core_DOM/common/tests/Core_DOM_BaseTest.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -32,9 +32,9 @@ text\This theory provides the common test setup that is used by all formal theory Core_DOM_BaseTest imports - (*<*) + (*<*) "../preliminaries/Testing_Utils" - (*>*) + (*>*) "../Core_DOM" begin @@ -47,7 +47,7 @@ notation assert_throws ("assert'_throws'(_, _')") definition "test p h \ h \ ok p" -definition field_access :: "(string \ (_, (_) object_ptr option) dom_prog) \ string +definition field_access :: "(string \ (_, (_) object_ptr option) dom_prog) \ string \ (_, (_) object_ptr option) dom_prog" (infix "." 80) where "field_access m field = m field" @@ -133,7 +133,7 @@ notation create_document_with_null ("createDocument'(_')") notation create_document_with_null2 ("createDocument'(_, _, _')") fun get_element_by_id_with_null :: "((_::linorder) object_ptr option) \ string \ (_, ((_) object_ptr option)) dom_prog" - where + where "get_element_by_id_with_null (Some ptr) id' = do { element_ptr_opt \ get_element_by_id ptr id'; (case element_ptr_opt of @@ -142,19 +142,23 @@ fun get_element_by_id_with_null :: "((_::linorder) object_ptr option) \ string \ (_, ((_) object_ptr option) list) dom_prog" - where +fun get_elements_by_class_name_with_null :: +"((_::linorder) object_ptr option) \ string \ (_, ((_) object_ptr option) list) dom_prog" + where "get_elements_by_class_name_with_null (Some ptr) class_name = get_elements_by_class_name ptr class_name \ map_M (return \ Some \ 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)" notation get_elements_by_class_name_with_null ("_ . getElementsByClassName'(_')") -fun get_elements_by_tag_name_with_null :: "((_::linorder) object_ptr option) \ string \ (_, ((_) object_ptr option) list) dom_prog" - where +fun get_elements_by_tag_name_with_null :: +"((_::linorder) object_ptr option) \ string \ (_, ((_) object_ptr option) list) dom_prog" + where "get_elements_by_tag_name_with_null (Some ptr) tag = get_elements_by_tag_name ptr tag \ map_M (return \ Some \ 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)" notation get_elements_by_tag_name_with_null ("_ . getElementsByTagName'(_')") -fun insert_before_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ ((_) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun insert_before_with_null :: +"((_::linorder) object_ptr option) \ ((_) object_ptr option) \ ((_) object_ptr option) \ +(_, ((_) object_ptr option)) dom_prog" where "insert_before_with_null (Some ptr) (Some child_obj) ref_child_obj_opt = (case cast child_obj of Some child \ do { @@ -165,7 +169,8 @@ fun insert_before_with_null :: "((_::linorder) object_ptr option) \ | None \ error HierarchyRequestError)" notation insert_before_with_null ("_ . insertBefore'(_, _')") -fun append_child_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ (_, unit) dom_prog" +fun append_child_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ +(_, unit) dom_prog" where "append_child_with_null (Some ptr) (Some child_obj) = (case cast child_obj of Some child \ append_child ptr child @@ -180,7 +185,8 @@ fun get_body :: "((_::linorder) object_ptr option) \ (_, ((_) object }" notation get_body ("_ . body") -fun get_document_element_with_null :: "((_::linorder) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun get_document_element_with_null :: "((_::linorder) object_ptr option) \ +(_, ((_) object_ptr option)) dom_prog" where "get_document_element_with_null (Some ptr) = (case 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 of Some document_ptr \ do { @@ -190,14 +196,16 @@ fun get_document_element_with_null :: "((_::linorder) object_ptr option) \ None)})" notation get_document_element_with_null ("_ . documentElement") -fun get_owner_document_with_null :: "((_::linorder) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun get_owner_document_with_null :: "((_::linorder) object_ptr option) \ +(_, ((_) object_ptr option)) dom_prog" where "get_owner_document_with_null (Some ptr) = (do { document_ptr \ get_owner_document ptr; return (Some (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))})" notation get_owner_document_with_null ("_ . ownerDocument") -fun remove_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun remove_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ +(_, ((_) object_ptr option)) dom_prog" where "remove_with_null (Some ptr) (Some child) = (case cast child of Some child_node \ do { @@ -208,7 +216,8 @@ fun remove_with_null :: "((_::linorder) object_ptr option) \ ((_) ob | "remove_with_null _ None = error TypeError" notation remove_with_null ("_ . remove'(')") -fun remove_child_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun remove_child_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ +(_, ((_) object_ptr option)) dom_prog" where "remove_child_with_null (Some ptr) (Some child) = (case cast child of Some child_node \ do { @@ -230,11 +239,11 @@ notation remove_attribute_with_null ("_ . removeAttribute'(_')") fun get_attribute_with_null :: "((_) object_ptr option) \ attr_key \ (_, attr_value option) dom_prog" where - "get_attribute_with_null (Some ptr) k = (case cast ptr of + "get_attribute_with_null (Some ptr) k = (case cast ptr of Some element_ptr \ get_attribute element_ptr k)" fun get_attribute_with_null2 :: "((_) object_ptr option) \ attr_key \ (_, attr_value) dom_prog" where - "get_attribute_with_null2 (Some ptr) k = (case cast ptr of + "get_attribute_with_null2 (Some ptr) k = (case cast ptr of Some element_ptr \ do { a \ get_attribute element_ptr k; return (the a)})" @@ -256,7 +265,8 @@ fun first_child_with_null :: "((_) object_ptr option) \ (_, ((_) obj | None \ None)}" notation first_child_with_null ("_ . firstChild") -fun adopt_node_with_null :: "((_::linorder) object_ptr option) \ ((_) object_ptr option) \ (_, ((_) object_ptr option)) dom_prog" +fun adopt_node_with_null :: +"((_::linorder) object_ptr option) \ ((_) object_ptr option) \(_, ((_) object_ptr option)) dom_prog" where "adopt_node_with_null (Some ptr) (Some child) = (case cast ptr of Some document_ptr \ (case cast child of @@ -264,9 +274,10 @@ fun adopt_node_with_null :: "((_::linorder) object_ptr option) \ ((_ adopt_node document_ptr child_node; return (Some child)}))" notation adopt_node_with_null ("_ . adoptNode'(_')") - -definition createTestTree :: "((_::linorder) object_ptr option) \ (_, (string \ (_, ((_) object_ptr option)) dom_prog)) dom_prog" + +definition createTestTree :: +"((_::linorder) object_ptr option) \ (_, (string \ (_, ((_) object_ptr option)) dom_prog)) dom_prog" where "createTestTree ref = return (\id. get_element_by_id_with_null ref id)" diff --git a/Core_DOM/Core_DOM/common/tests/Document_adoptNode.thy b/Core_DOM/Core_DOM/common/tests/Document_adoptNode.thy index 652dccb..2594df9 100644 --- a/Core_DOM/Core_DOM/common/tests/Document_adoptNode.thy +++ b/Core_DOM/Core_DOM/common/tests/Document_adoptNode.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/common/tests/Document_getElementById.thy b/Core_DOM/Core_DOM/common/tests/Document_getElementById.thy index 6c5b481..3256741 100644 --- a/Core_DOM/Core_DOM/common/tests/Document_getElementById.thy +++ b/Core_DOM/Core_DOM/common/tests/Document_getElementById.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/common/tests/Node_insertBefore.thy b/Core_DOM/Core_DOM/common/tests/Node_insertBefore.thy index 5ebf2a7..e847ba3 100644 --- a/Core_DOM/Core_DOM/common/tests/Node_insertBefore.thy +++ b/Core_DOM/Core_DOM/common/tests/Node_insertBefore.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/common/tests/Node_removeChild.thy b/Core_DOM/Core_DOM/common/tests/Node_removeChild.thy index 497db8e..065ed12 100644 --- a/Core_DOM/Core_DOM/common/tests/Node_removeChild.thy +++ b/Core_DOM/Core_DOM/common/tests/Node_removeChild.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) diff --git a/Core_DOM/Core_DOM/standard/Core_DOM_Heap_WF.thy b/Core_DOM/Core_DOM/standard/Core_DOM_Heap_WF.thy index 0bb8321..69c7e10 100644 --- a/Core_DOM/Core_DOM/standard/Core_DOM_Heap_WF.thy +++ b/Core_DOM/Core_DOM/standard/Core_DOM_Heap_WF.thy @@ -23,80 +23,98 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Wellformedness\ -text\In this theory, we discuss the wellformedness of the DOM. First, we define -wellformedness and, second, we show for all functions for querying and modifying the +text\In this theory, we discuss the wellformedness of the DOM. First, we define +wellformedness and, second, we show for all functions for querying and modifying the DOM to what extend they preserve wellformendess.\ theory Core_DOM_Heap_WF -imports - "Core_DOM_Functions" + imports + "Core_DOM_Functions" begin locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_child_nodes_defs get_child_nodes get_child_nodes_locs + l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs for get_child_nodes :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin definition a_owner_document_valid :: "(_) heap \ bool" where "a_owner_document_valid h \ (\node_ptr \ fset (node_ptr_kinds h). - ((\document_ptr. document_ptr |\| document_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 + \ (\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)))) + 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] + 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 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)" + 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" + 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)))" + 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))))" + 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 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))))" + 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" + 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 + "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 @@ -115,12 +133,13 @@ definition a_all_ptrs_in_heap :: "(_) heap \ bool" where "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))" + (\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 + where "a_distinct_lists h = distinct (concat ( - (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r) + (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r) @ (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r) ))" @@ -134,31 +153,31 @@ locale l_heap_is_wellformed_defs = fixes heap_is_wellformed :: "(_) heap \ bool" fixes parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" -global_interpretation l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs -defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes +global_interpretation l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes get_disconnected_nodes" - and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes" - and acyclic_heap = a_acyclic_heap - and all_ptrs_in_heap = a_all_ptrs_in_heap - and distinct_lists = a_distinct_lists - and owner_document_valid = a_owner_document_valid + and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes" + and acyclic_heap = a_acyclic_heap + and all_ptrs_in_heap = a_all_ptrs_in_heap + and distinct_lists = a_distinct_lists + and owner_document_valid = a_owner_document_valid . locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs - + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs + + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs + l_heap_is_wellformed_defs heap_is_wellformed parent_child_rel + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed" assumes parent_child_rel_impl: "parent_child_rel = a_parent_child_rel" begin @@ -190,10 +209,10 @@ lemma parent_child_rel_child_nodes2: lemma parent_child_rel_finite: "finite (parent_child_rel h)" proof - - have "parent_child_rel h = (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. + have "parent_child_rel h = (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. (\child \ set |h \ get_child_nodes ptr|\<^sub>r. {(ptr, cast child)}))" by(auto simp add: parent_child_rel_def) - moreover have "finite (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. + moreover have "finite (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. (\child \ set |h \ get_child_nodes ptr|\<^sub>r. {(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child)}))" by simp ultimately show ?thesis @@ -204,15 +223,15 @@ lemma distinct_lists_no_parent: assumes "a_distinct_lists h" assumes "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assumes "node_ptr \ set disc_nodes" - shows "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h + shows "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" using assms apply(auto simp add: a_distinct_lists_def)[1] proof - fix parent_ptr :: "(_) object_ptr" assume a1: "parent_ptr |\| object_ptr_kinds h" - assume a2: "(\x\fset (object_ptr_kinds h). - set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). + assume a2: "(\x\fset (object_ptr_kinds h). + set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). set |h \ get_disconnected_nodes x|\<^sub>r) = {}" assume a3: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assume a4: "node_ptr \ set disc_nodes" @@ -233,15 +252,15 @@ lemma distinct_lists_disconnected_nodes: and "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" shows "distinct disc_nodes" proof - - have h1: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + have h1: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using assms(1) by(simp add: a_distinct_lists_def) then show ?thesis using concat_map_all_distinct[OF h1] assms(2) is_OK_returns_result_I get_disconnected_nodes_ok - by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M - l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap - l_get_disconnected_nodes_axioms select_result_I2) + by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M + l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap + l_get_disconnected_nodes_axioms select_result_I2) qed lemma distinct_lists_children: @@ -256,8 +275,8 @@ proof (cases "children = []", simp) by(simp add: a_distinct_lists_def) show ?thesis using concat_map_all_distinct[OF h1] assms(2) assms(3) - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap - is_OK_returns_result_I select_result_I2) + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap + is_OK_returns_result_I select_result_I2) qed lemma heap_is_wellformed_children_in_heap: @@ -267,7 +286,8 @@ 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 (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.get_child_nodes_ptr_in_heap select_result_I2 subsetD) + 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" @@ -281,55 +301,58 @@ proof (auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1] assume a1: "ptr \ ptr'" assume a2: "h \ get_child_nodes ptr \\<^sub>r children" assume a3: "h \ get_child_nodes ptr' \\<^sub>r children'" - assume a4: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) + assume a4: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))))" have f5: "|h \ get_child_nodes ptr|\<^sub>r = children" using a2 by simp have "|h \ get_child_nodes ptr'|\<^sub>r = children'" using a3 by (meson select_result_I2) - then have "ptr \ set (sorted_list_of_set (fset (object_ptr_kinds h))) - \ ptr' \ set (sorted_list_of_set (fset (object_ptr_kinds h))) + then have "ptr \ set (sorted_list_of_set (fset (object_ptr_kinds h))) + \ ptr' \ set (sorted_list_of_set (fset (object_ptr_kinds h))) \ set children \ set children' = {}" using f5 a4 a1 by (meson distinct_concat_map_E(1)) then show False - using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I - local.get_child_nodes_ptr_in_heap set_sorted_list_of_set) + using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I + local.get_child_nodes_ptr_in_heap set_sorted_list_of_set) qed -lemma parent_child_rel_child: - "h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ (ptr, cast child) \ parent_child_rel h" +lemma parent_child_rel_child: + "h \ get_child_nodes ptr \\<^sub>r children \ +child \ set children \ (ptr, cast child) \ parent_child_rel h" by (simp add: is_OK_returns_result_I get_child_nodes_ptr_in_heap parent_child_rel_def) lemma parent_child_rel_acyclic: "heap_is_wellformed h \ acyclic (parent_child_rel h)" by (simp add: acyclic_heap_def local.heap_is_wellformed_def) -lemma heap_is_wellformed_disconnected_nodes_distinct: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ distinct disc_nodes" +lemma heap_is_wellformed_disconnected_nodes_distinct: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ +distinct disc_nodes" using distinct_lists_disconnected_nodes local.heap_is_wellformed_def by blast -lemma parent_child_rel_parent_in_heap: +lemma parent_child_rel_parent_in_heap: "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" using local.parent_child_rel_def by blast -lemma parent_child_rel_child_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptr parent +lemma parent_child_rel_child_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptr parent \ (parent, child_ptr) \ parent_child_rel h \ child_ptr |\| object_ptr_kinds h" apply(auto simp add: heap_is_wellformed_def parent_child_rel_def a_all_ptrs_in_heap_def)[1] using get_child_nodes_ok by (meson finite_set_in subsetD) -lemma heap_is_wellformed_disc_nodes_in_heap: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes +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 (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) + 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 - \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' +lemma heap_is_wellformed_one_disc_parent: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' \ set disc_nodes \ set disc_nodes' \ {} \ document_ptr = document_ptr'" - using DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1) - is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap - local.heap_is_wellformed_def select_result_I2 + using DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1) + is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap + local.heap_is_wellformed_def select_result_I2 proof - assume a1: "heap_is_wellformed h" assume a2: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" @@ -344,117 +367,117 @@ proof - then have "distinct (concat (map (\d. |h \ get_disconnected_nodes d|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using a1 local.a_distinct_lists_def local.heap_is_wellformed_def by blast then show ?thesis - using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1) - is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) + using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1) + is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) qed -lemma heap_is_wellformed_children_disc_nodes_different: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes +lemma heap_is_wellformed_children_disc_nodes_different: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ set children \ set disc_nodes = {}" - by (metis (no_types, hide_lams) disjoint_iff_not_equal distinct_lists_no_parent - is_OK_returns_result_I local.get_child_nodes_ptr_in_heap - local.heap_is_wellformed_def select_result_I2) + by (metis (no_types, hide_lams) disjoint_iff_not_equal distinct_lists_no_parent + is_OK_returns_result_I local.get_child_nodes_ptr_in_heap + local.heap_is_wellformed_def select_result_I2) -lemma heap_is_wellformed_children_disc_nodes: - "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h - \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) +lemma heap_is_wellformed_children_disc_nodes: + "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h + \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) \ (\document_ptr \ fset (document_ptr_kinds h). node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def a_owner_document_valid_def)[1] by (meson fmember.rep_eq) -lemma heap_is_wellformed_children_distinct: +lemma heap_is_wellformed_children_distinct: "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append - distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def - local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def - select_result_I2) + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append + distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def + local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def + select_result_I2) end -locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + -assumes heap_is_wellformed_children_in_heap: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ child \ set children +locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + + assumes heap_is_wellformed_children_in_heap: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ child |\| node_ptr_kinds h" -assumes heap_is_wellformed_disc_nodes_in_heap: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes 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" -assumes heap_is_wellformed_one_parent: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_child_nodes ptr' \\<^sub>r children' + assumes heap_is_wellformed_one_parent: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_child_nodes ptr' \\<^sub>r children' \ set children \ set children' \ {} \ ptr = ptr'" -assumes heap_is_wellformed_one_disc_parent: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes - \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' + assumes heap_is_wellformed_one_disc_parent: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' \ set disc_nodes \ set disc_nodes' \ {} \ document_ptr = document_ptr'" -assumes heap_is_wellformed_children_disc_nodes_different: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes heap_is_wellformed_children_disc_nodes_different: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ set children \ set disc_nodes = {}" -assumes heap_is_wellformed_disconnected_nodes_distinct: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes heap_is_wellformed_disconnected_nodes_distinct: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ distinct disc_nodes" -assumes heap_is_wellformed_children_distinct: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" -assumes heap_is_wellformed_children_disc_nodes: - "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h - \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) + assumes heap_is_wellformed_children_distinct: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" + assumes heap_is_wellformed_children_disc_nodes: + "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h + \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) \ (\document_ptr \ fset (document_ptr_kinds h). node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" -assumes parent_child_rel_child: - "h \ get_child_nodes ptr \\<^sub>r children + assumes parent_child_rel_child: + "h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ (ptr, cast child) \ parent_child_rel h" -assumes parent_child_rel_finite: - "heap_is_wellformed h \ finite (parent_child_rel h)" -assumes parent_child_rel_acyclic: - "heap_is_wellformed h \ acyclic (parent_child_rel h)" -assumes parent_child_rel_node_ptr: - "(parent, child_ptr) \ parent_child_rel h \ is_node_ptr_kind child_ptr" -assumes parent_child_rel_parent_in_heap: - "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" -assumes parent_child_rel_child_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptr parent + assumes parent_child_rel_finite: + "heap_is_wellformed h \ finite (parent_child_rel h)" + assumes parent_child_rel_acyclic: + "heap_is_wellformed h \ acyclic (parent_child_rel h)" + assumes parent_child_rel_node_ptr: + "(parent, child_ptr) \ parent_child_rel h \ is_node_ptr_kind child_ptr" + assumes parent_child_rel_parent_in_heap: + "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" + assumes parent_child_rel_child_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptr parent \ (parent, child_ptr) \ parent_child_rel h \ child_ptr |\| object_ptr_kinds h" -interpretation i_heap_is_wellformed?: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel +interpretation i_heap_is_wellformed?: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel apply(unfold_locales) by(auto simp add: heap_is_wellformed_def parent_child_rel_def) declare l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma heap_is_wellformed_is_l_heap_is_wellformed [instances]: - "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes + "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes" apply(auto simp add: l_heap_is_wellformed_def)[1] - using heap_is_wellformed_children_in_heap + using heap_is_wellformed_children_in_heap apply blast - using heap_is_wellformed_disc_nodes_in_heap + using heap_is_wellformed_disc_nodes_in_heap apply blast - using heap_is_wellformed_one_parent + using heap_is_wellformed_one_parent apply blast - using heap_is_wellformed_one_disc_parent + using heap_is_wellformed_one_disc_parent apply blast - using heap_is_wellformed_children_disc_nodes_different + using heap_is_wellformed_children_disc_nodes_different apply blast - using heap_is_wellformed_disconnected_nodes_distinct + using heap_is_wellformed_disconnected_nodes_distinct apply blast - using heap_is_wellformed_children_distinct + using heap_is_wellformed_children_distinct apply blast - using heap_is_wellformed_children_disc_nodes + using heap_is_wellformed_children_disc_nodes apply blast - using parent_child_rel_child + using parent_child_rel_child apply (blast) - using parent_child_rel_child + using parent_child_rel_child apply(blast) - using parent_child_rel_finite + using parent_child_rel_finite apply blast - using parent_child_rel_acyclic + using parent_child_rel_acyclic apply blast - using parent_child_rel_node_ptr + using parent_child_rel_node_ptr apply blast - using parent_child_rel_parent_in_heap + using parent_child_rel_parent_in_heap apply blast - using parent_child_rel_child_in_heap + using parent_child_rel_child_in_heap apply blast done @@ -462,21 +485,21 @@ subsection \get\_parent\ locale l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma child_parent_dual: assumes heap_is_wellformed: "heap_is_wellformed h" @@ -489,10 +512,10 @@ proof - obtain ptrs where ptrs: "h \ object_ptr_kinds_M \\<^sub>r ptrs" by(simp add: object_ptr_kinds_M_defs) then have h1: "ptr \ set ptrs" - using get_child_nodes_ok assms(2) is_OK_returns_result_I - by (metis (no_types, hide_lams) ObjectMonad.ptr_kinds_ptr_kinds_M - \\thesis. (\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs \ thesis) \ thesis\ - get_child_nodes_ptr_in_heap returns_result_eq select_result_I2) + using get_child_nodes_ok assms(2) is_OK_returns_result_I + by (metis (no_types, hide_lams) ObjectMonad.ptr_kinds_ptr_kinds_M + \\thesis. (\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs \ thesis) \ thesis\ + get_child_nodes_ptr_in_heap returns_result_eq select_result_I2) let ?P = "(\ptr. get_child_nodes ptr \ (\children. return (child \ set children)))" let ?filter = "filter_M ?P ptrs" @@ -501,50 +524,50 @@ proof - using ptrs type_wf using get_child_nodes_ok apply(auto intro!: filter_M_is_OK_I bind_is_OK_pure_I get_child_nodes_ok simp add: bind_pure_I)[1] - using assms(4) local.known_ptrs_known_ptr by blast + using assms(4) local.known_ptrs_known_ptr by blast then obtain parent_ptrs where parent_ptrs: "h \ ?filter \\<^sub>r parent_ptrs" by auto - have h5: "\!x. x \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes x) + have h5: "\!x. x \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (child \ set children)) \\<^sub>r True" apply(auto intro!: bind_pure_returns_result_I)[1] using heap_is_wellformed_one_parent proof - have "h \ (return (child \ set children)::((_) heap, exception, bool) prog) \\<^sub>r True" by (simp add: assms(3)) - then show - "\z. z \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes z) + then show + "\z. z \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes z) (\ns. return (child \ set ns)) \\<^sub>r True" - by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I - local.get_child_nodes_pure select_result_I2) + by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I + local.get_child_nodes_pure select_result_I2) next fix x y assume 0: "x \ set ptrs" - and 1: "h \ Heap_Error_Monad.bind (get_child_nodes x) + and 1: "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (child \ set children)) \\<^sub>r True" and 2: "y \ set ptrs" - and 3: "h \ Heap_Error_Monad.bind (get_child_nodes y) + and 3: "h \ Heap_Error_Monad.bind (get_child_nodes y) (\children. return (child \ set children)) \\<^sub>r True" - and 4: "(\h ptr children ptr' children'. heap_is_wellformed h - \ h \ get_child_nodes ptr \\<^sub>r children \ h \ get_child_nodes ptr' \\<^sub>r children' + and 4: "(\h ptr children ptr' children'. heap_is_wellformed h + \ h \ get_child_nodes ptr \\<^sub>r children \ h \ get_child_nodes ptr' \\<^sub>r children' \ set children \ set children' \ {} \ ptr = ptr')" then show "x = y" - by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed - return_returns_result) + by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed + return_returns_result) qed have "child |\| node_ptr_kinds h" using heap_is_wellformed_children_in_heap heap_is_wellformed assms(2) assms(3) - by fast + by fast moreover have "parent_ptrs = [ptr]" apply(rule filter_M_ex1[OF parent_ptrs h1 h5]) - using ptrs assms(2) assms(3) + using ptrs assms(2) assms(3) by(auto simp add: object_ptr_kinds_M_defs bind_pure_I intro!: bind_pure_returns_result_I) ultimately show ?thesis using ptrs parent_ptrs - by(auto simp add: bind_pure_I get_parent_def - elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *) + by(auto simp add: bind_pure_I get_parent_def + elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *) qed lemma parent_child_rel_parent: @@ -555,7 +578,7 @@ lemma parent_child_rel_parent: lemma heap_wellformed_induct [consumes 1, case_names step]: assumes "heap_is_wellformed h" - and step: "\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children + and step: "\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child)) \ P parent" shows "P ptr" proof - @@ -575,7 +598,7 @@ lemma heap_wellformed_induct2 [consumes 3, case_names not_in_heap empty_children assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" and not_in_heap: "\parent. parent |\| object_ptr_kinds h \ P parent" and empty_children: "\parent. h \ get_child_nodes parent \\<^sub>r [] \ P parent" - and step: "\parent children child. h \ get_child_nodes parent \\<^sub>r children + and step: "\parent children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child) \ P parent" shows "P ptr" proof(insert assms(1), induct rule: heap_wellformed_induct) @@ -584,7 +607,7 @@ proof(insert assms(1), induct rule: heap_wellformed_induct) proof(cases "parent |\| object_ptr_kinds h") case True then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" - using get_child_nodes_ok assms(2) assms(3) + using get_child_nodes_ok assms(2) assms(3) by (meson is_OK_returns_result_E local.known_ptrs_known_ptr) then show ?thesis proof (cases "children = []") @@ -599,21 +622,21 @@ proof(insert assms(1), induct rule: heap_wellformed_induct) qed next case False - then show ?thesis + then show ?thesis by (simp add: not_in_heap) qed qed lemma heap_wellformed_induct_rev [consumes 1, case_names step]: assumes "heap_is_wellformed h" - and step: "\child. (\parent child_node. cast child_node = child + and step: "\child. (\parent child_node. cast child_node = child \ h \ get_parent child_node \\<^sub>r Some parent \ P parent) \ P child" shows "P ptr" proof - fix ptr have "wf ((parent_child_rel h))" - by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite - wf_iff_acyclic_if_finite) + by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite + wf_iff_acyclic_if_finite) then show "?thesis" proof (induct rule: wf_induct_rule) @@ -625,9 +648,9 @@ proof - qed end -interpretation i_get_parent_wf?: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed - parent_child_rel get_disconnected_nodes +interpretation i_get_parent_wf?: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed + parent_child_rel get_disconnected_nodes using instances by(simp add: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -635,43 +658,43 @@ declare l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ locale l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs - heap_is_wellformed parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + heap_is_wellformed parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma preserves_wellformedness_writes_needed: assumes heap_is_wellformed: "heap_is_wellformed h" and "h \ f \\<^sub>h h'" and "writes SW f h h'" - and preserved_get_child_nodes: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_get_child_nodes: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. \r \ get_child_nodes_locs object_ptr. r h h'" - and preserved_get_disconnected_nodes: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_get_disconnected_nodes: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \document_ptr. \r \ get_disconnected_nodes_locs document_ptr. r h h'" - and preserved_object_pointers: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_object_pointers: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" -shows "heap_is_wellformed h'" + shows "heap_is_wellformed h'" proof - have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" using assms(2) assms(3) object_ptr_kinds_preserved preserved_object_pointers by blast - then have object_ptr_kinds_eq: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" - unfolding object_ptr_kinds_M_defs by simp + then have object_ptr_kinds_eq: + "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + unfolding object_ptr_kinds_M_defs by simp then have object_ptr_kinds_eq2: "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" using select_result_eq by force then have node_ptr_kinds_eq2: "|h \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" @@ -681,21 +704,21 @@ proof - have document_ptr_kinds_eq2: "|h \ document_ptr_kinds_M|\<^sub>r = |h' \ document_ptr_kinds_M|\<^sub>r" using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" - by auto - have children_eq: + by auto + have children_eq: "\ptr children. h \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" apply(rule reads_writes_preserved[OF get_child_nodes_reads assms(3) assms(2)]) using preserved_get_child_nodes by fast then have children_eq2: "\ptr. |h \ get_child_nodes ptr|\<^sub>r = |h' \ get_child_nodes ptr|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: - "\document_ptr disconnected_nodes. - h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes + have disconnected_nodes_eq: + "\document_ptr disconnected_nodes. + h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads assms(3) assms(2)]) using preserved_get_disconnected_nodes by fast - then have disconnected_nodes_eq2: - "\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r + then have disconnected_nodes_eq2: + "\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force have get_parent_eq: "\ptr parent. h \ get_parent ptr \\<^sub>r parent = h' \ get_parent ptr \\<^sub>r parent" @@ -716,42 +739,43 @@ 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 (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) + by (simp add: children_eq2 disconnected_nodes_eq2 document_ptr_kinds_eq3 + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_all_ptrs_in_heap_def node_ptr_kinds_eq3 object_ptr_kinds_eq3) moreover have h0: "a_distinct_lists h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) - have h1: "map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h))) + have h1: "map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h))) = map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))" - by (simp add: children_eq2 object_ptr_kinds_eq3) - have h2: "map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) - (sorted_list_of_set (fset (document_ptr_kinds h))) - = map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + by (simp add: children_eq2 object_ptr_kinds_eq3) + have h2: "map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + (sorted_list_of_set (fset (document_ptr_kinds h))) + = map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))" using disconnected_nodes_eq document_ptr_kinds_eq2 select_result_eq by force have "a_distinct_lists h'" - using h0 + using h0 by(simp add: a_distinct_lists_def h1 h2) moreover have "a_owner_document_valid h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" - by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2 - object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3) + by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2 + object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3) ultimately show ?thesis by (simp add: heap_is_wellformed_def) qed end -interpretation i_get_parent_wf2?: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs get_parent get_parent_locs - heap_is_wellformed parent_child_rel get_disconnected_nodes - get_disconnected_nodes_locs +interpretation i_get_parent_wf2?: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs get_parent get_parent_locs + heap_is_wellformed parent_child_rel get_disconnected_nodes + get_disconnected_nodes_locs using l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms by (simp add: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_get_parent_defs + +locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_get_parent_defs + assumes child_parent_dual: "heap_is_wellformed h \ type_wf h @@ -761,25 +785,25 @@ locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs \ h \ get_parent child \\<^sub>r Some ptr" assumes heap_wellformed_induct [consumes 1, case_names step]: "heap_is_wellformed h - \ (\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children + \ (\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child)) \ P parent) \ P ptr" assumes heap_wellformed_induct_rev [consumes 1, case_names step]: "heap_is_wellformed h - \ (\child. (\parent child_node. cast child_node = child + \ (\child. (\parent child_node. cast child_node = child \ h \ get_parent child_node \\<^sub>r Some parent \ P parent) \ P child) \ P ptr" - assumes parent_child_rel_parent: "heap_is_wellformed h - \ h \ get_parent child_node \\<^sub>r Some parent + assumes parent_child_rel_parent: "heap_is_wellformed h + \ h \ get_parent child_node \\<^sub>r Some parent \ (parent, cast child_node) \ parent_child_rel h" -lemma get_parent_wf_is_l_get_parent_wf [instances]: - "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel +lemma get_parent_wf_is_l_get_parent_wf [instances]: + "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def)[1] using child_parent_dual heap_wellformed_induct heap_wellformed_induct_rev parent_child_rel_parent - by metis+ + by metis+ @@ -794,21 +818,21 @@ subsubsection \get\_disconnected\_nodes\ locale l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_set_disconnected_nodes_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and 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 heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and 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 heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma remove_from_disconnected_nodes_removes: @@ -818,33 +842,33 @@ lemma remove_from_disconnected_nodes_removes: assumes "h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes'" shows "node_ptr \ set disc_nodes'" using assms - by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct - set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1) - returns_result_eq) + by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct + set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1) + returns_result_eq) end locale l_set_disconnected_nodes_get_disconnected_nodes_wf = l_heap_is_wellformed - + l_set_disconnected_nodes_get_disconnected_nodes + + + l_set_disconnected_nodes_get_disconnected_nodes + assumes remove_from_disconnected_nodes_removes: - "heap_is_wellformed h \ h \ get_disconnected_nodes ptr \\<^sub>r disc_nodes - \ h \ set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \\<^sub>h h' - \ h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes' + "heap_is_wellformed h \ h \ get_disconnected_nodes ptr \\<^sub>r disc_nodes + \ h \ set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \\<^sub>h h' + \ h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes' \ node_ptr \ set disc_nodes'" interpretation i_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M?: - l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs heap_is_wellformed + l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs heap_is_wellformed parent_child_rel get_child_nodes using instances by (simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] - + lemma set_disconnected_nodes_get_disconnected_nodes_wf_is_l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]: - "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformed parent_child_rel + "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs" - apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def - l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1] + apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def + l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1] using remove_from_disconnected_nodes_removes apply fast done @@ -853,31 +877,31 @@ subsection \get\_root\_node\ locale l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_get_parent_wf - type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes - get_child_nodes_locs get_parent get_parent_locs + type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes + get_child_nodes_locs get_parent get_parent_locs + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs - get_ancestors get_ancestors_locs get_root_node get_root_node_locs + type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs + get_ancestors get_ancestors_locs get_root_node get_root_node_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and known_ptrs :: "(_) heap \ bool" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" - and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" - and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and known_ptrs :: "(_) heap \ bool" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" + and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" + and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" begin lemma get_ancestors_reads: @@ -888,10 +912,10 @@ proof (insert assms(1), induct rule: heap_wellformed_induct_rev) then show ?case using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def] apply(simp (no_asm) add: get_ancestors_def) - by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers - intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] - reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads] - split: option.splits) + by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers + intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] + reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads] + split: option.splits) qed lemma get_ancestors_ok: @@ -930,13 +954,14 @@ lemma get_root_node_ok: lemma get_ancestors_parent: assumes "heap_is_wellformed h" and "h \ get_parent child \\<^sub>r Some parent" - shows "h \ get_ancestors (cast child) \\<^sub>r (cast child) # parent # ancestors + shows "h \ get_ancestors (cast child) \\<^sub>r (cast child) # parent # ancestors \ h \ get_ancestors parent \\<^sub>r parent # ancestors" proof - assume a1: "h \ get_ancestors (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" + assume a1: "h \ get_ancestors (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r +cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" then have "h \ Heap_Error_Monad.bind (check_in_heap (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child)) (\_. Heap_Error_Monad.bind (get_parent child) - (\x. Heap_Error_Monad.bind (case x of None \ return [] | Some x \ get_ancestors x) + (\x. Heap_Error_Monad.bind (case x of None \ return [] | Some x \ get_ancestors x) (\ancestors. return (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # ancestors)))) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" by(simp add: get_ancestors_def) @@ -946,12 +971,12 @@ proof next assume "h \ get_ancestors parent \\<^sub>r parent # ancestors" then show "h \ get_ancestors (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" - using assms(2) + using assms(2) apply(simp (no_asm) add: get_ancestors_def) apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] - by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I - local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust - select_result_I) + by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I + local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust + select_result_I) qed @@ -975,12 +1000,12 @@ proof(insert assms(2), induct arbitrary: ancestors rule: heap_wellformed_induct_ with Some show ?case proof(induct parent_opt) case None - then show ?case + then show ?case apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits) next case (Some option) - then show ?case + then show ?case apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits) qed @@ -994,21 +1019,21 @@ lemma get_ancestors_subset: and "h \ get_ancestors ptr \\<^sub>r ancestors" and "ancestor \ set ancestors" and "h \ get_ancestors ancestor \\<^sub>r ancestor_ancestors" -and type_wf: "type_wf h" -and known_ptrs: "known_ptrs h" + and type_wf: "type_wf h" + and known_ptrs: "known_ptrs h" shows "set ancestor_ancestors \ set ancestors" -proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors - rule: heap_wellformed_induct_rev) +proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors + rule: heap_wellformed_induct_rev) case (step child) have "child |\| object_ptr_kinds h" using get_ancestors_ptr_in_heap step(2) by auto - (* then have "h \ check_in_heap child \\<^sub>r ()" + (* then have "h \ check_in_heap child \\<^sub>r ()" using returns_result_select_result by force *) show ?case proof (induct "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child") case None then have "ancestors = [child]" - using step(2) step(3) + using step(2) step(3) by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2) show ?case using step(2) step(3) @@ -1018,9 +1043,10 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors case (Some child_node) note s1 = Some obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" - using \child |\| object_ptr_kinds h\ assms(1) Some[symmetric] get_parent_ok[OF type_wf known_ptrs] - by (metis (no_types, lifting) is_OK_returns_result_E known_ptrs get_parent_ok - l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_casts_commute node_ptr_kinds_commutes) + using \child |\| object_ptr_kinds h\ assms(1) Some[symmetric] + get_parent_ok[OF type_wf known_ptrs] + by (metis (no_types, lifting) is_OK_returns_result_E known_ptrs get_parent_ok + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_casts_commute node_ptr_kinds_commutes) then show ?case proof (induct parent_opt) case None @@ -1037,8 +1063,8 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors have "h \ Heap_Error_Monad.bind (check_in_heap child) (\_. Heap_Error_Monad.bind (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child of None \ return [] - | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) - (\parent_ptr_opt. case parent_ptr_opt of None \ return [] + | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) + (\parent_ptr_opt. case parent_ptr_opt of None \ return [] | Some x \ get_ancestors x)) (\ancestors. return (child # ancestors))) \\<^sub>r ancestors" @@ -1051,8 +1077,8 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors using s1 Some by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq) show ?case - using step(1)[OF s1[symmetric, simplified] Some \h \ get_ancestors parent \\<^sub>r tl_ancestors\] - step(3) + using step(1)[OF s1[symmetric, simplified] Some \h \ get_ancestors parent \\<^sub>r tl_ancestors\] + step(3) apply(auto simp add: tl_ancestors)[1] by (metis assms(4) insert_iff list.simps(15) local.step(2) returns_result_eq tl_ancestors) qed @@ -1069,13 +1095,13 @@ lemma get_ancestors_also_parent: shows "parent \ set ancestors" proof - obtain child_ancestors where child_ancestors: "h \ get_ancestors (cast child) \\<^sub>r child_ancestors" - by (meson assms(1) assms(4) get_ancestors_ok is_OK_returns_result_I known_ptrs - local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result - type_wf) + by (meson assms(1) assms(4) get_ancestors_ok is_OK_returns_result_I known_ptrs + local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result + type_wf) then have "parent \ set child_ancestors" apply(simp add: get_ancestors_def) - by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)] - get_ancestors_ptr) + by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)] + get_ancestors_ptr) then show ?thesis using assms child_ancestors get_ancestors_subset by blast qed @@ -1087,16 +1113,16 @@ lemma get_ancestors_obtains_children: and "h \ get_ancestors ptr \\<^sub>r ancestors" and type_wf: "type_wf h" and known_ptrs: "known_ptrs h" - obtains children ancestor_child where "h \ get_child_nodes ancestor \\<^sub>r children" + obtains children ancestor_child where "h \ get_child_nodes ancestor \\<^sub>r children" and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" proof - assume 0: "(\children ancestor_child. h \ get_child_nodes ancestor \\<^sub>r children \ - ancestor_child \ set children \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ancestor_child \ set ancestors + ancestor_child \ set children \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ancestor_child \ set ancestors \ thesis)" have "\child. h \ get_parent child \\<^sub>r Some ancestor \ cast child \ set ancestors" - proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors - rule: heap_wellformed_induct_rev) + proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors + rule: heap_wellformed_induct_rev) case (step child) have "child |\| object_ptr_kinds h" using get_ancestors_ptr_in_heap step(4) by auto @@ -1115,8 +1141,8 @@ proof - obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" using \child |\| object_ptr_kinds h\ assms(1) Some[symmetric] using get_parent_ok known_ptrs type_wf - by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute - node_ptr_kinds_commutes) + by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute + node_ptr_kinds_commutes) then show ?case proof (induct parent_opt) case None @@ -1132,8 +1158,8 @@ proof - have "h \ Heap_Error_Monad.bind (check_in_heap child) (\_. Heap_Error_Monad.bind (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child of None \ return [] - | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) - (\parent_ptr_opt. case parent_ptr_opt of None \ return [] + | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) + (\parent_ptr_opt. case parent_ptr_opt of None \ return [] | Some x \ get_ancestors x)) (\ancestors. return (child # ancestors))) \\<^sub>r ancestors" @@ -1145,15 +1171,15 @@ proof - ultimately have "h \ get_ancestors parent \\<^sub>r tl_ancestors" using s1 Some by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq) - (* have "ancestor \ parent" *) + (* have "ancestor \ parent" *) have "ancestor \ set tl_ancestors" using tl_ancestors step(2) step(3) by auto show ?case proof (cases "ancestor \ parent") case True - show ?thesis - using step(1)[OF s1[symmetric, simplified] Some True - \ancestor \ set tl_ancestors\ \h \ get_ancestors parent \\<^sub>r tl_ancestors\] + show ?thesis + using step(1)[OF s1[symmetric, simplified] Some True + \ancestor \ set tl_ancestors\ \h \ get_ancestors parent \\<^sub>r tl_ancestors\] using tl_ancestors by auto next case False @@ -1165,8 +1191,8 @@ proof - qed qed qed - then obtain child where child: "h \ get_parent child \\<^sub>r Some ancestor" - and in_ancestors: "cast child \ set ancestors" + then obtain child where child: "h \ get_parent child \\<^sub>r Some ancestor" + and in_ancestors: "cast child \ set ancestors" by auto then obtain children where children: "h \ get_child_nodes ancestor \\<^sub>r children" and @@ -1181,7 +1207,7 @@ lemma get_ancestors_parent_child_rel: and "h \ get_ancestors child \\<^sub>r ancestors" and known_ptrs: "known_ptrs h" and type_wf: "type_wf h" -shows "(ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" + shows "(ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" proof (safe) assume 3: "(ptr, child) \ (parent_child_rel h)\<^sup>*" show "ptr \ set ancestors" @@ -1192,33 +1218,33 @@ proof (safe) case True then show ?thesis by (metis (no_types, lifting) assms(2) bind_returns_result_E get_ancestors_def - in_set_member member_rec(1) return_returns_result) + in_set_member member_rec(1) return_returns_result) next case False obtain ptr_child where ptr_child: "(ptr, ptr_child) \ (parent_child_rel h) \ (ptr_child, child) \ (parent_child_rel h)\<^sup>*" using converse_rtranclE[OF 1(2)] \ptr \ child\ by metis - then obtain ptr_child_node - where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node" + then obtain ptr_child_node + where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node" using ptr_child node_ptr_casts_commute3 parent_child_rel_node_ptr by (metis ) then obtain children where children: "h \ get_child_nodes ptr \\<^sub>r children" and ptr_child_node: "ptr_child_node \ set children" proof - - assume a1: "\children. \h \ get_child_nodes ptr \\<^sub>r children; ptr_child_node \ set children\ + assume a1: "\children. \h \ get_child_nodes ptr \\<^sub>r children; ptr_child_node \ set children\ \ thesis" - + have "ptr |\| object_ptr_kinds h" using local.parent_child_rel_parent_in_heap ptr_child by blast moreover have "ptr_child_node \ set |h \ get_child_nodes ptr|\<^sub>r" - by (metis calculation known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr - local.parent_child_rel_child ptr_child ptr_child_ptr_child_node - returns_result_select_result type_wf) + by (metis calculation known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr + local.parent_child_rel_child ptr_child ptr_child_ptr_child_node + returns_result_select_result type_wf) ultimately show ?thesis using a1 get_child_nodes_ok type_wf known_ptrs - by (meson local.known_ptrs_known_ptr returns_result_select_result) + by (meson local.known_ptrs_known_ptr returns_result_select_result) qed moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \ (parent_child_rel h)\<^sup>*" using ptr_child ptr_child_ptr_child_node by auto @@ -1226,12 +1252,12 @@ proof (safe) using 1 by auto moreover have "h \ get_parent ptr_child_node \\<^sub>r Some ptr" using assms(1) children ptr_child_node child_parent_dual - using known_ptrs type_wf by blast + using known_ptrs type_wf by blast ultimately show ?thesis using get_ancestors_also_parent assms type_wf by blast qed qed - next +next assume 3: "ptr \ set ancestors" show "(ptr, child) \ (parent_child_rel h)\<^sup>*" proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)]) @@ -1251,12 +1277,12 @@ proof (safe) using known_ptrs type_wf by blast then have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \ (parent_child_rel h)\<^sup>*" using 1(1) by blast - + moreover have "(ptr, cast ptr_child_node) \ parent_child_rel h" using children ptr_child_node assms(1) parent_child_rel_child_nodes2 using child_parent_dual known_ptrs parent_child_rel_parent type_wf by blast - + ultimately show ?thesis by auto qed @@ -1288,15 +1314,15 @@ lemma get_ancestors_eq: proof - have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" using pointers_preserved object_ptr_kinds_preserved_small by blast - then have object_ptr_kinds_M_eq: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + then have object_ptr_kinds_M_eq: + "\ptrs. h \ 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_eq: "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" by(simp) have "h' \ ok (get_ancestors ptr)" using get_ancestors_ok get_ancestors_ptr_in_heap object_ptr_kinds_eq3 assms(1) known_ptrs - known_ptrs' assms(2) assms(7) type_wf' - by blast + known_ptrs' assms(2) assms(7) type_wf' + by blast then obtain ancestors' where ancestors': "h' \ get_ancestors ptr \\<^sub>r ancestors'" by auto @@ -1309,8 +1335,8 @@ proof - by(auto simp add: get_root_node_def elim!: bind_returns_result_E2 split: option.splits) qed - have children_eq: - "\p children. p \ ptr \ h \ get_child_nodes p \\<^sub>r children = h' \ get_child_nodes p \\<^sub>r children" + have children_eq: + "\p children. p \ ptr \ h \ get_child_nodes p \\<^sub>r children = h' \ get_child_nodes p \\<^sub>r children" using get_child_nodes_reads assms(3) apply(simp add: reads_def reflp_def transp_def preserved_def) by blast @@ -1319,7 +1345,7 @@ proof - using assms(1) local.parent_child_rel_acyclic by auto have "acyclic (parent_child_rel h')" using assms(2) local.parent_child_rel_acyclic by blast - have 2: "\c parent_opt. cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c \ set ancestors \ set ancestors' + have 2: "\c parent_opt. cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c \ set ancestors \ set ancestors' \ h \ get_parent c \\<^sub>r parent_opt = h' \ get_parent c \\<^sub>r parent_opt" proof - fix c parent_opt @@ -1337,47 +1363,47 @@ proof - proof (cases "p = ptr") case True have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*" - using get_ancestors_parent_child_rel 1 assms by blast + using get_ancestors_parent_child_rel 1 assms by blast then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)" proof (cases "cast c = ptr") case True - then show ?thesis + then show ?thesis using \acyclic (parent_child_rel h)\ by(auto simp add: acyclic_def) next case False then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)\<^sup>*" - using \acyclic (parent_child_rel h)\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl - \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*\ + using \acyclic (parent_child_rel h)\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl + \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*\ by (metis acyclic_def) then show ?thesis using r_into_rtrancl by auto qed obtain children where children: "h \ get_child_nodes ptr \\<^sub>r children" - using type_wf - by (metis \h' \ ok get_ancestors ptr\ assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok - heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr - object_ptr_kinds_eq3) + using type_wf + by (metis \h' \ ok get_ancestors ptr\ assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok + heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr + object_ptr_kinds_eq3) then have "c \ set children" using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)\ assms(1) using parent_child_rel_child_nodes2 using child_parent_dual known_ptrs parent_child_rel_parent - type_wf by blast + type_wf by blast with children have "h \ ?P p \\<^sub>r False" by(auto simp add: True) moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*" - using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf - type_wf' by blast + using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf + type_wf' by blast then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')" proof (cases "cast c = ptr") case True - then show ?thesis + then show ?thesis using \acyclic (parent_child_rel h')\ by(auto simp add: acyclic_def) next case False then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\<^sup>*" using \acyclic (parent_child_rel h')\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl - \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*\ + \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*\ by (metis acyclic_def) then show ?thesis using r_into_rtrancl by auto @@ -1385,12 +1411,12 @@ proof - then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')" using r_into_rtrancl by auto obtain children' where children': "h' \ get_child_nodes ptr \\<^sub>r children'" - using type_wf type_wf' - by (meson \h' \ ok (get_ancestors ptr)\ assms(2) get_ancestors_ptr_in_heap - get_child_nodes_ok is_OK_returns_result_E known_ptrs' - local.known_ptrs_known_ptr) + using type_wf type_wf' + by (meson \h' \ ok (get_ancestors ptr)\ assms(2) get_ancestors_ptr_in_heap + get_child_nodes_ok is_OK_returns_result_E known_ptrs' + local.known_ptrs_known_ptr) then have "c \ set children'" - using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\ assms(2) type_wf type_wf' + using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\ assms(2) type_wf type_wf' using parent_child_rel_child_nodes2 child_parent_dual known_ptrs' parent_child_rel_parent by auto with children' have "h' \ ?P p \\<^sub>r False" @@ -1402,76 +1428,76 @@ proof - case False then show ?thesis using children_eq ptrs - by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E - get_child_nodes_pure return_returns_result) + by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E + get_child_nodes_pure return_returns_result) qed qed - have "\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + have "\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf type_wf' - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I - get_child_nodes_ok get_child_nodes_pure known_ptrs' - local.known_ptrs_known_ptr return_ok select_result_I2) - have children_eq_False: - "\pa. pa \ set ptrs \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r False = h' \ get_child_nodes pa + using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf type_wf' + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I + get_child_nodes_ok get_child_nodes_pure known_ptrs' + local.known_ptrs_known_ptr return_ok select_result_I2) + have children_eq_False: + "\pa. pa \ set ptrs \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r False = h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" proof fix pa - assume "pa \ set ptrs" - and "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - have "h \ ok (get_child_nodes pa \ (\children. return (c \ set children))) + assume "pa \ set ptrs" + and "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" + have "h \ ok (get_child_nodes pa \ (\children. return (c \ set children))) \ h' \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using \pa \ set ptrs\ \\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa - \ (\children. return (c \ set children)))\ + using \pa \ set ptrs\ \\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + \ (\children. return (c \ set children)))\ by auto - moreover have "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False + moreover have "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False \ h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - by (metis (mono_tags, lifting) \\pa. pa \ set ptrs - \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ - calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) + by (metis (mono_tags, lifting) \\pa. pa \ set ptrs + \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ + calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) ultimately show "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" using \h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False\ by auto next fix pa - assume "pa \ set ptrs" + assume "pa \ set ptrs" and "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - have "h' \ ok (get_child_nodes pa \ (\children. return (c \ set children))) + have "h' \ ok (get_child_nodes pa \ (\children. return (c \ set children))) \ h \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using \pa \ set ptrs\ \\pa. pa \ set ptrs - \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa - \ (\children. return (c \ set children)))\ + using \pa \ set ptrs\ \\pa. pa \ set ptrs + \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + \ (\children. return (c \ set children)))\ by auto - moreover have "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False + moreover have "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False \ h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - by (metis (mono_tags, lifting) - \\pa. pa \ set ptrs \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ - calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) + by (metis (mono_tags, lifting) + \\pa. pa \ set ptrs \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ + calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) ultimately show "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" using \h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False\ by blast qed have filter_eq: "\xs. h \ filter_M ?P ptrs \\<^sub>r xs = h' \ filter_M ?P ptrs \\<^sub>r xs" proof (rule filter_M_eq) - show - "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h" + show + "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h" by(auto intro!: bind_pure_I) next - show - "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h'" + show + "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h'" by(auto intro!: bind_pure_I) next fix xs b x assume 0: "x \ set ptrs" - then show "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b + then show "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b = h' \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b" apply(induct b) using children_eq_True apply blast @@ -1498,15 +1524,15 @@ proof - qed have "ancestors = ancestors'" - proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors' - rule: heap_wellformed_induct_rev) + proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors' + rule: heap_wellformed_induct_rev) case (step child) show ?case using step(2) step(3) step(4) apply(simp add: get_ancestors_def) apply(auto intro!: elim!: bind_returns_result_E2 split: option.splits)[1] using returns_result_eq apply fastforce - apply (meson option.simps(3) returns_result_eq) + apply (meson option.simps(3) returns_result_eq) by (metis IntD1 IntD2 option.inject returns_result_eq step.hyps) qed then show ?thesis @@ -1519,7 +1545,7 @@ lemma get_ancestors_remains_not_in_ancestors: and "heap_is_wellformed h'" and "h \ get_ancestors ptr \\<^sub>r ancestors" and "h' \ get_ancestors ptr \\<^sub>r ancestors'" - and "\p children children'. h \ get_child_nodes p \\<^sub>r children + and "\p children children'. h \ get_child_nodes p \\<^sub>r children \ h' \ get_child_nodes p \\<^sub>r children' \ set children' \ set children" and "node \ set ancestors" and object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" @@ -1528,7 +1554,7 @@ lemma get_ancestors_remains_not_in_ancestors: and type_wf': "type_wf h'" shows "node \ set ancestors'" proof - - have object_ptr_kinds_M_eq: + have object_ptr_kinds_M_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" using object_ptr_kinds_eq3 by(simp add: object_ptr_kinds_M_defs) @@ -1536,8 +1562,8 @@ proof - by(simp) show ?thesis - proof (insert assms(1) assms(3) assms(4) assms(6), induct ptr arbitrary: ancestors ancestors' - rule: heap_wellformed_induct_rev) + proof (insert assms(1) assms(3) assms(4) assms(6), induct ptr arbitrary: ancestors ancestors' + rule: heap_wellformed_induct_rev) case (step child) have 1: "\p parent. h' \ get_parent p \\<^sub>r Some parent \ h \ get_parent p \\<^sub>r Some parent" proof - @@ -1548,11 +1574,11 @@ proof - p_in_children': "p \ set children'" using get_parent_child_dual by blast obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" - using get_child_nodes_ok assms(1) get_child_nodes_ptr_in_heap object_ptr_kinds_eq children' - known_ptrs + using get_child_nodes_ok assms(1) get_child_nodes_ptr_in_heap object_ptr_kinds_eq children' + known_ptrs using type_wf type_wf' - by (metis \h' \ get_parent p \\<^sub>r Some parent\ get_parent_parent_in_heap is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis \h' \ get_parent p \\<^sub>r Some parent\ get_parent_parent_in_heap is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) have "p \ set children" using assms(5) children children' p_in_children' by blast @@ -1560,13 +1586,13 @@ proof - using child_parent_dual assms(1) children known_ptrs type_wf by blast qed have "node \ child" - using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs + using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs using type_wf type_wf' by blast then show ?case using step(2) step(3) apply(simp add: get_ancestors_def) - using step(4) + using step(4) apply(auto elim!: bind_returns_result_E2 split: option.splits)[1] using 1 apply (meson option.distinct(1) returns_result_eq) @@ -1591,8 +1617,8 @@ next by(auto simp add: get_ancestors_def[of x] elim!: bind_returns_result_E2 split: option.splits) then show ?case using Cons.hyps Cons.prems(2) get_ancestors_ptr_in_heap x - by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap - is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap + is_OK_returns_result_I) qed @@ -1602,26 +1628,27 @@ lemma get_ancestors_prefix: assumes "ptr' \ set ancestors" assumes "h \ get_ancestors ptr' \\<^sub>r ancestors'" shows "\pre. ancestors = pre @ ancestors'" -proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors' - rule: heap_wellformed_induct) +proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors' + rule: heap_wellformed_induct) case (step parent) then show ?case proof (cases "parent \ ptr" ) case True - then obtain children ancestor_child where "h \ get_child_nodes parent \\<^sub>r children" - and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" - using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast - then have "h \ get_parent ancestor_child \\<^sub>r Some parent" - using assms(1) assms(2) assms(3) child_parent_dual by blast - then have "h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'" - apply(simp add: get_ancestors_def) - using \h \ get_ancestors parent \\<^sub>r ancestors'\ get_parent_ptr_in_heap - by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I) - then show ?thesis - using step(1) \h \ get_child_nodes parent \\<^sub>r children\ \ancestor_child \ set children\ - \cast ancestor_child \ set ancestors\ \h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'\ - by fastforce + then obtain children ancestor_child where "h \ get_child_nodes parent \\<^sub>r children" + and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" + using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast + then have "h \ get_parent ancestor_child \\<^sub>r Some parent" + using assms(1) assms(2) assms(3) child_parent_dual by blast + then have "h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'" + apply(simp add: get_ancestors_def) + using \h \ get_ancestors parent \\<^sub>r ancestors'\ get_parent_ptr_in_heap + by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I) + then show ?thesis + using step(1) \h \ get_child_nodes parent \\<^sub>r children\ \ancestor_child \ set children\ + \cast ancestor_child \ set ancestors\ + \h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'\ + by fastforce next case False then show ?thesis @@ -1638,25 +1665,25 @@ lemma get_ancestors_same_root_node: shows "h \ get_root_node ptr' \\<^sub>r root_ptr \ h \ get_root_node ptr'' \\<^sub>r root_ptr" proof - have "ptr' |\| object_ptr_kinds h" - by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children - get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children + get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) then obtain ancestors' where ancestors': "h \ get_ancestors ptr' \\<^sub>r ancestors'" by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E) then have "\pre. ancestors = pre @ ancestors'" using get_ancestors_prefix assms by blast moreover have "ptr'' |\| object_ptr_kinds h" - by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children - get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children + get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) then obtain ancestors'' where ancestors'': "h \ get_ancestors ptr'' \\<^sub>r ancestors''" by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E) then have "\pre. ancestors = pre @ ancestors''" using get_ancestors_prefix assms by blast ultimately show ?thesis using ancestors' ancestors'' - apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2 + apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)[1] - apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR - returns_result_eq) + apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR + returns_result_eq) by (metis assms(1) get_ancestors_never_empty last_appendR returns_result_eq) qed @@ -1668,7 +1695,7 @@ proof show "h \ get_root_node ptr \\<^sub>r root" using 1[unfolded get_root_node_def] assms apply(simp add: get_ancestors_def) - apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I split: option.splits)[1] using returns_result_eq apply fastforce using get_ancestors_ptr by fastforce @@ -1678,8 +1705,8 @@ next apply(simp add: get_root_node_def) using assms 1 apply(simp add: get_ancestors_def) - apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I split: option.splits)[1] + apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I split: option.splits)[1] apply (simp add: check_in_heap_def is_OK_returns_result_I) using get_ancestors_ptr get_parent_ptr_in_heap apply (simp add: is_OK_returns_result_I) @@ -1704,9 +1731,9 @@ proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev) case (Some child_node) note s = this then obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" - by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap - is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute - node_ptr_kinds_commutes returns_result_select_result step.prems) + by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap + is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute + node_ptr_kinds_commutes returns_result_select_result step.prems) then show ?thesis proof(induct parent_opt) case None @@ -1716,8 +1743,8 @@ proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev) case (Some parent) then show ?case using step s - apply(auto simp add: get_root_node_def get_ancestors_def[of c] - elim!: bind_returns_result_E2 split: option.splits list.splits)[1] + apply(auto simp add: get_root_node_def get_ancestors_def[of c] + elim!: bind_returns_result_E2 split: option.splits list.splits)[1] using get_root_node_parent_same step.hyps step.prems by auto qed qed @@ -1729,8 +1756,8 @@ lemma get_root_node_not_node_same: shows "h \ get_root_node ptr \\<^sub>r ptr" using assms apply(simp add: get_root_node_def get_ancestors_def) - by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I split: option.splits) + by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I split: option.splits) lemma get_root_node_root_in_heap: @@ -1746,86 +1773,86 @@ lemma get_root_node_same_no_parent_parent_child_rel: assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" assumes "h \ get_root_node ptr' \\<^sub>r ptr'" shows "\(\p. (p, ptr') \ (parent_child_rel h))" - by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent - l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok - local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr - local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent + l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok + local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr + local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq + returns_result_select_result) end -locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs - + l_get_child_nodes_defs + l_get_parent_defs + +locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs + + l_get_child_nodes_defs + l_get_parent_defs + assumes get_ancestors_never_empty: "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ ancestors \ []" assumes get_ancestors_ok: - "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h + "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h \ h \ ok (get_ancestors ptr)" assumes get_ancestors_reads: "heap_is_wellformed h \ reads get_ancestors_locs (get_ancestors node_ptr) h h'" - assumes get_ancestors_ptrs_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors + assumes get_ancestors_ptrs_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors \ ptr' |\| object_ptr_kinds h" assumes get_ancestors_remains_not_in_ancestors: - "heap_is_wellformed h \ heap_is_wellformed h' \ h \ get_ancestors ptr \\<^sub>r ancestors - \ h' \ get_ancestors ptr \\<^sub>r ancestors' - \ (\p children children'. h \ get_child_nodes p \\<^sub>r children - \ h' \ get_child_nodes p \\<^sub>r children' - \ set children' \ set children) - \ node \ set ancestors - \ object_ptr_kinds h = object_ptr_kinds h' \ known_ptrs h + "heap_is_wellformed h \ heap_is_wellformed h' \ h \ get_ancestors ptr \\<^sub>r ancestors + \ h' \ get_ancestors ptr \\<^sub>r ancestors' + \ (\p children children'. h \ get_child_nodes p \\<^sub>r children + \ h' \ get_child_nodes p \\<^sub>r children' + \ set children' \ set children) + \ node \ set ancestors + \ object_ptr_kinds h = object_ptr_kinds h' \ known_ptrs h \ type_wf h \ type_wf h' \ node \ set ancestors'" assumes get_ancestors_also_parent: - "heap_is_wellformed h \ h \ get_ancestors some_ptr \\<^sub>r ancestors - \ cast child_node \ set ancestors - \ h \ get_parent child_node \\<^sub>r Some parent \ type_wf h + "heap_is_wellformed h \ h \ get_ancestors some_ptr \\<^sub>r ancestors + \ cast child_node \ set ancestors + \ h \ get_parent child_node \\<^sub>r Some parent \ type_wf h \ known_ptrs h \ parent \ set ancestors" assumes get_ancestors_obtains_children: - "heap_is_wellformed h \ ancestor \ ptr \ ancestor \ set ancestors - \ h \ get_ancestors ptr \\<^sub>r ancestors \ type_wf h \ known_ptrs h - \ (\children ancestor_child . h \ get_child_nodes ancestor \\<^sub>r children - \ ancestor_child \ set children - \ cast ancestor_child \ set ancestors - \ thesis) + "heap_is_wellformed h \ ancestor \ ptr \ ancestor \ set ancestors + \ h \ get_ancestors ptr \\<^sub>r ancestors \ type_wf h \ known_ptrs h + \ (\children ancestor_child . h \ get_child_nodes ancestor \\<^sub>r children + \ ancestor_child \ set children + \ cast ancestor_child \ set ancestors + \ thesis) \ thesis" assumes get_ancestors_parent_child_rel: - "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ known_ptrs h \ type_wf h + "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ known_ptrs h \ type_wf h \ (ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" -locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf - + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs + - assumes get_root_node_ok: - "heap_is_wellformed h \ known_ptrs h \ type_wf h \ ptr |\| object_ptr_kinds h +locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf + + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs + + assumes get_root_node_ok: + "heap_is_wellformed h \ known_ptrs h \ type_wf h \ ptr |\| object_ptr_kinds h \ h \ ok (get_root_node ptr)" - assumes get_root_node_ptr_in_heap: + assumes get_root_node_ptr_in_heap: "h \ ok (get_root_node ptr) \ ptr |\| object_ptr_kinds h" - assumes get_root_node_root_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h + assumes get_root_node_root_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_root_node ptr \\<^sub>r root \ root |\| object_ptr_kinds h" - assumes get_ancestors_same_root_node: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors - \ ptr'' \ set ancestors + assumes get_ancestors_same_root_node: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors + \ ptr'' \ set ancestors \ h \ get_root_node ptr' \\<^sub>r root_ptr \ h \ get_root_node ptr'' \\<^sub>r root_ptr" - assumes get_root_node_same_no_parent: - "heap_is_wellformed h \ type_wf h \ known_ptrs h + 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_parent_same: - "h \ get_parent child \\<^sub>r Some 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" interpretation i_get_root_node_wf?: - l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel - get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel + get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs using instances by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]: - "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors + "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors get_ancestors_locs get_child_nodes get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def)[1] @@ -1841,7 +1868,7 @@ lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]: done lemma get_root_node_wf_is_l_get_root_node_wf [instances]: - "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs + "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs get_ancestors get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def)[1] @@ -1856,7 +1883,7 @@ lemma get_root_node_wf_is_l_get_root_node_wf [instances]: subsection \to\_tree\_order\ -locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = +locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_parent + l_get_parent_wf + @@ -1880,7 +1907,7 @@ lemma to_tree_order_either_ptr_or_in_children: and "node \ set nodes" and "h \ get_child_nodes ptr \\<^sub>r children" and "node \ ptr" - obtains child child_to where "child \ set children" + obtains child child_to where "child \ set children" and "h \ to_tree_order (cast child) \\<^sub>r child_to" and "node \ set child_to" proof - obtain treeorders where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" @@ -1890,11 +1917,11 @@ proof - then have "node \ set (concat treeorders)" using assms[simplified to_tree_order_def] by(auto elim!: bind_returns_result_E4 dest: pure_returns_heap_eq) - then obtain treeorder where "treeorder \ set treeorders" - and node_in_treeorder: "node \ set treeorder" + then obtain treeorder where "treeorder \ set treeorders" + and node_in_treeorder: "node \ set treeorder" by auto - then obtain child where "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r treeorder" - and "child \ set children" + then obtain child where "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r treeorder" + and "child \ set children" using assms[simplified to_tree_order_def] treeorders by(auto elim!: map_M_pure_E2) then show ?thesis @@ -1911,7 +1938,7 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel case (step parent) have "parent |\| object_ptr_kinds h" using assms(1) assms(2) assms(3) step.prems(1) to_tree_order_ptr_in_heap by blast - then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" + then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr) then show ?case proof (cases "children = []") @@ -1920,7 +1947,7 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel using step(2) children apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_returns_result_E2)[1] by (metis list.distinct(1) list.map_disc_iff list.set_cases map_M_pure_E2 returns_result_eq) - then show ?thesis + then show ?thesis using \parent |\| object_ptr_kinds h\ step.prems(2) by auto next case False @@ -1933,9 +1960,9 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel using \parent |\| object_ptr_kinds h\ by blast next case False - then show ?thesis - using children step.hyps to_tree_order_either_ptr_or_in_children - by (metis step.prems(1) step.prems(2)) + then show ?thesis + using children step.hyps to_tree_order_either_ptr_or_in_children + by (metis step.prems(1) step.prems(2)) qed qed qed @@ -1958,16 +1985,16 @@ qed lemma to_tree_order_child_subset: assumes "heap_is_wellformed h" - and "h \ to_tree_order ptr \\<^sub>r nodes" - and "h \ get_child_nodes ptr \\<^sub>r children" - and "node \ set children" - and "h \ to_tree_order (cast node) \\<^sub>r nodes'" - shows "set nodes' \ set nodes" + and "h \ to_tree_order ptr \\<^sub>r nodes" + and "h \ get_child_nodes ptr \\<^sub>r children" + and "node \ set children" + and "h \ to_tree_order (cast node) \\<^sub>r nodes'" + shows "set nodes' \ set nodes" proof fix x assume a1: "x \ set nodes'" - moreover obtain treeorders - where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" + moreover obtain treeorders + where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" using assms(2) assms(3) apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1] using pure_returns_heap_eq returns_result_eq by fastforce @@ -1997,7 +2024,7 @@ lemma to_tree_order_subset: and type_wf: "type_wf h" shows "set nodes' \ set nodes" proof - - have "\nodes. h \ to_tree_order ptr \\<^sub>r nodes \ (\node. node \ set nodes + have "\nodes. h \ to_tree_order ptr \\<^sub>r nodes \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes))" proof(insert assms(1), induct ptr rule: heap_wellformed_induct) case (step parent) @@ -2006,8 +2033,8 @@ proof - fix nodes node nodes' x assume 1: "(\children child. h \ get_child_nodes parent \\<^sub>r children \ - child \ set children \ \nodes. h \ to_tree_order (cast child) \\<^sub>r nodes - \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' + child \ set children \ \nodes. h \ to_tree_order (cast child) \\<^sub>r nodes + \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes)))" and 2: "h \ to_tree_order parent \\<^sub>r nodes" and 3: "node \ set nodes" @@ -2015,7 +2042,7 @@ proof - and "x \ set nodes'" have h1: "(\children child nodes node nodes'. h \ get_child_nodes parent \\<^sub>r children \ - child \ set children \ h \ to_tree_order (cast child) \\<^sub>r nodes + child \ set children \ h \ to_tree_order (cast child) \\<^sub>r nodes \ (node \ set nodes \ (h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes)))" using 1 by blast @@ -2026,8 +2053,8 @@ proof - proof (cases "children = []") case True then show ?thesis - by (metis "2" "3" \h \ to_tree_order node \\<^sub>r nodes'\ children empty_iff list.set(1) - subsetI to_tree_order_either_ptr_or_in_children) + by (metis "2" "3" \h \ to_tree_order node \\<^sub>r nodes'\ children empty_iff list.set(1) + subsetI to_tree_order_either_ptr_or_in_children) next case False then show ?thesis @@ -2041,8 +2068,8 @@ proof - "child \ set children" and "h \ to_tree_order (cast child) \\<^sub>r nodes_of_child" and "node \ set nodes_of_child" - using 2[simplified to_tree_order_def] 3 - to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children + using 2[simplified to_tree_order_def] 3 + to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children apply(auto elim!: bind_returns_result_E2 intro: map_M_pure_I)[1] using is_OK_returns_result_E 2 a_all_ptrs_in_heap_def assms(1) heap_is_wellformed_def using "3" by blast @@ -2050,8 +2077,8 @@ proof - using h1 using \h \ to_tree_order node \\<^sub>r nodes'\ children by blast moreover have "set nodes_of_child \ set nodes" - using "2" \child \ set children\ \h \ to_tree_order (cast child) \\<^sub>r nodes_of_child\ - assms children to_tree_order_child_subset by auto + using "2" \child \ set children\ \h \ to_tree_order (cast child) \\<^sub>r nodes_of_child\ + assms children to_tree_order_child_subset by auto ultimately show ?thesis by blast qed @@ -2083,18 +2110,18 @@ proof - child: "child \ set children" using assms get_parent_child_dual by blast then obtain child_to where child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r child_to" - by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I - get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok) + by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I + get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok) then have "cast child \ set child_to" apply(simp add: to_tree_order_def) - by(auto elim!: bind_returns_result_E2 map_M_pure_E - dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I) - + by(auto elim!: bind_returns_result_E2 map_M_pure_E + dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I) + have "cast child \ set nodes'" using nodes' child apply(simp add: to_tree_order_def) - apply(auto elim!: bind_returns_result_E2 map_M_pure_E - dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I)[1] + apply(auto elim!: bind_returns_result_E2 map_M_pure_E + dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I)[1] using child_to \cast child \ set child_to\ returns_result_eq by fastforce ultimately show ?thesis by auto @@ -2107,9 +2134,9 @@ lemma to_tree_order_child: assumes "cast child \ ptr" assumes "child \ set children" assumes "cast child \ set nodes" -shows "parent \ set nodes" -proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes - rule: heap_wellformed_induct) + shows "parent \ set nodes" +proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2121,22 +2148,22 @@ proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated]) + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated]) next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "cast child \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] by (metis (full_types) assms(1) assms(2) assms(3) get_parent_ptr_in_heap - is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual - l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes - returns_result_select_result step.prems(1) step.prems(2) step.prems(3) - to_tree_order_either_ptr_or_in_children to_tree_order_ok) + is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual + l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes + returns_result_select_result step.prems(1) step.prems(2) step.prems(3) + to_tree_order_either_ptr_or_in_children to_tree_order_ok) then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2146,16 +2173,16 @@ proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes then have "parent = p" using step(3) children child assms(5) assms(7) by (meson assms(1) assms(2) assms(3) child_parent_dual option.inject returns_result_eq) - + then show ?thesis using step.prems(1) to_tree_order_ptr_in_result by blast next case False - then show ?thesis - using step(1)[OF children child child_to] step(3) step(4) - using \set child_to \ set nodes\ - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ by auto - qed + then show ?thesis + using step(1)[OF children child child_to] step(3) step(4) + using \set child_to \ set nodes\ + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ by auto + qed qed qed @@ -2165,8 +2192,8 @@ lemma to_tree_order_node_ptrs: assumes "ptr' \ ptr" assumes "ptr' \ set nodes" shows "is_node_ptr_kind ptr'" -proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes - rule: heap_wellformed_induct) +proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2178,18 +2205,18 @@ proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "ptr' \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] - using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2216,7 +2243,7 @@ proof - assume 1: "(\parent. h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes \ thesis)" show thesis proof(insert assms(1) assms(4) assms(5) assms(6) 1, induct ptr arbitrary: nodes - rule: heap_wellformed_induct) + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2228,18 +2255,18 @@ proof - case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated]) + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated]) next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "cast child \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] - using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2252,14 +2279,14 @@ proof - proof (induct parent_opt) case None then show ?case - by (metis \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ assms(1) assms(2) assms(3) - cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject child child_parent_dual child_to children - option.distinct(1) returns_result_eq step.hyps) + by (metis \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ assms(1) assms(2) assms(3) + cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject child child_parent_dual child_to children + option.distinct(1) returns_result_eq step.hyps) next case (Some option) - then show ?case - by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2) - step.prems(3) step.prems(4) to_tree_order_child) + then show ?case + by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2) + step.prems(3) step.prems(4) to_tree_order_child) qed qed qed @@ -2289,15 +2316,15 @@ proof using \ptr \ child\ by (metis "1.prems" rtranclE) obtain child_node where child_node: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child" - using \(child_parent, child) \ parent_child_rel h\ node_ptr_casts_commute3 - parent_child_rel_node_ptr + using \(child_parent, child) \ parent_child_rel h\ node_ptr_casts_commute3 + parent_child_rel_node_ptr by blast then have "h \ get_parent child_node \\<^sub>r Some child_parent" using \(child_parent, child) \ (parent_child_rel h)\ - by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual - l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok - local.known_ptrs_known_ptr local.l_get_parent_wf_axioms - local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap) + by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual + l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok + local.known_ptrs_known_ptr local.l_get_parent_wf_axioms + local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap) then show ?thesis using 1(1) child_node \(ptr, child_parent) \ (parent_child_rel h)\<^sup>*\ using assms(1) assms(2) assms(3) assms(4) to_tree_order_parent by blast @@ -2316,8 +2343,8 @@ next next case False then have "\parent. (parent, child) \ (parent_child_rel h)" - using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)] - to_tree_order_node_ptrs + using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)] + to_tree_order_node_ptrs by (metis assms(1) assms(2) assms(3) node_ptr_casts_commute3 parent_child_rel_parent) then obtain child_node where child_node: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child" using node_ptr_casts_commute3 parent_child_rel_node_ptr by blast @@ -2327,8 +2354,8 @@ next then have "(child_parent, child) \ (parent_child_rel h)" using assms(1) child_node parent_child_rel_parent by blast moreover have "child_parent \ set to" - by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent - get_parent_child_dual to_tree_order_child) + by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent + get_parent_child_dual to_tree_order_child) then have "(ptr, child_parent) \ (parent_child_rel h)\<^sup>*" using 1 child_node child_parent by blast ultimately show ?thesis @@ -2338,60 +2365,60 @@ next qed end -interpretation i_to_tree_order_wf?: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs to_tree_order known_ptrs get_parent - get_parent_locs heap_is_wellformed parent_child_rel - get_disconnected_nodes get_disconnected_nodes_locs +interpretation i_to_tree_order_wf?: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs to_tree_order known_ptrs get_parent + get_parent_locs heap_is_wellformed parent_child_rel + get_disconnected_nodes get_disconnected_nodes_locs using instances apply(simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) done declare l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs - + l_to_tree_order_defs - + l_get_parent_defs + l_get_child_nodes_defs + - assumes to_tree_order_ok: - "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h +locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_to_tree_order_defs + + l_get_parent_defs + l_get_child_nodes_defs + + assumes to_tree_order_ok: + "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h \ h \ ok (to_tree_order ptr)" - assumes to_tree_order_ptrs_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + assumes to_tree_order_ptrs_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to \ ptr' \ set to \ ptr' |\| object_ptr_kinds h" assumes to_tree_order_parent_child_rel: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to \ (ptr, child_ptr) \ (parent_child_rel h)\<^sup>* \ child_ptr \ set to" - assumes to_tree_order_child2: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ cast child \ ptr \ cast child \ set nodes - \ (\parent. h \ get_parent child \\<^sub>r Some parent - \ parent \ set nodes \ thesis) + assumes to_tree_order_child2: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ cast child \ ptr \ cast child \ set nodes + \ (\parent. h \ get_parent child \\<^sub>r Some parent + \ parent \ set nodes \ thesis) \ thesis" - assumes to_tree_order_node_ptrs: + assumes to_tree_order_node_ptrs: "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes \ ptr' \ ptr \ ptr' \ set nodes \ is_node_ptr_kind ptr'" - assumes to_tree_order_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ h \ get_child_nodes parent \\<^sub>r children \ cast child \ ptr - \ child \ set children \ cast child \ set nodes + assumes to_tree_order_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ h \ get_child_nodes parent \\<^sub>r children \ cast child \ ptr + \ child \ set children \ cast child \ set nodes \ parent \ set nodes" - assumes to_tree_order_ptr_in_result: + assumes to_tree_order_ptr_in_result: "h \ to_tree_order ptr \\<^sub>r nodes \ ptr \ set nodes" - assumes to_tree_order_parent: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes + assumes to_tree_order_parent: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes \ cast child \ set nodes" assumes to_tree_order_subset: - "heap_is_wellformed h \ h \ to_tree_order ptr \\<^sub>r nodes \ node \ set nodes - \ h \ to_tree_order node \\<^sub>r nodes' \ known_ptrs h + "heap_is_wellformed h \ h \ to_tree_order ptr \\<^sub>r nodes \ node \ set nodes + \ h \ to_tree_order node \\<^sub>r nodes' \ known_ptrs h \ type_wf h \ set nodes' \ set nodes" -lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: - "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs +lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: + "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs to_tree_order get_parent get_child_nodes" using instances apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def)[1] - using to_tree_order_ok + using to_tree_order_ok apply blast - using to_tree_order_ptrs_in_heap + using to_tree_order_ptrs_in_heap apply blast using to_tree_order_parent_child_rel apply(blast, blast) @@ -2399,7 +2426,7 @@ lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: apply blast using to_tree_order_node_ptrs apply blast - using to_tree_order_child + using to_tree_order_child apply blast using to_tree_order_ptr_in_result apply blast @@ -2425,27 +2452,27 @@ lemma to_tree_order_get_root_node: shows "h \ get_root_node ptr'' \\<^sub>r root_ptr" proof - obtain ancestors' where ancestors': "h \ get_ancestors ptr' \\<^sub>r ancestors'" - by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E - to_tree_order_ptrs_in_heap ) + by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E + to_tree_order_ptrs_in_heap ) moreover have "ptr \ set ancestors'" using \h \ get_ancestors ptr' \\<^sub>r ancestors'\ - using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel - to_tree_order_parent_child_rel by blast + using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel + to_tree_order_parent_child_rel by blast ultimately have "h \ get_root_node ptr \\<^sub>r root_ptr" using \h \ get_root_node ptr' \\<^sub>r root_ptr\ using assms(1) assms(2) assms(3) get_ancestors_ptr get_ancestors_same_root_node by blast - + obtain ancestors'' where ancestors'': "h \ get_ancestors ptr'' \\<^sub>r ancestors''" - by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E - to_tree_order_ptrs_in_heap) + by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E + to_tree_order_ptrs_in_heap) moreover have "ptr \ set ancestors''" using \h \ get_ancestors ptr'' \\<^sub>r ancestors''\ - using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel - to_tree_order_parent_child_rel by blast + using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel + to_tree_order_parent_child_rel by blast ultimately show ?thesis - using \h \ get_root_node ptr \\<^sub>r root_ptr\ assms(1) assms(2) assms(3) get_ancestors_ptr - get_ancestors_same_root_node by blast + using \h \ get_root_node ptr \\<^sub>r root_ptr\ assms(1) assms(2) assms(3) get_ancestors_ptr + get_ancestors_same_root_node by blast qed lemma to_tree_order_same_root: @@ -2461,25 +2488,25 @@ proof (insert assms(1)(* assms(4) assms(5) *) assms(6), induct ptr' rule: heap_ case True then have "child = root_ptr" using assms(1) assms(2) assms(3) assms(5) step.prems - by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3 - option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs) + by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3 + option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs) then show ?thesis using True by blast next case False - then obtain child_node parent where "cast child_node = child" - and "h \ get_parent child_node \\<^sub>r Some parent" - by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent - local.get_root_node_not_node_same local.get_root_node_same_no_parent - local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3 - step.prems) + then obtain child_node parent where "cast child_node = child" + and "h \ get_parent child_node \\<^sub>r Some parent" + by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent + local.get_root_node_not_node_same local.get_root_node_same_no_parent + local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3 + step.prems) then show ?thesis proof (cases "child = root_ptr") case True then have "h \ get_root_node root_ptr \\<^sub>r root_ptr" using assms(4) - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ assms(1) assms(2) assms(3) - get_root_node_no_parent get_root_node_same_no_parent + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ assms(1) assms(2) assms(3) + get_root_node_no_parent get_root_node_same_no_parent by blast then show ?thesis using step assms(4) @@ -2487,41 +2514,43 @@ proof (insert assms(1)(* assms(4) assms(5) *) assms(6), induct ptr' rule: heap_ next case False then have "parent \ set to" - using assms(5) step(2) to_tree_order_child \h \ get_parent child_node \\<^sub>r Some parent\ - \cast child_node = child\ + using assms(5) step(2) to_tree_order_child \h \ get_parent child_node \\<^sub>r Some parent\ + \cast child_node = child\ by (metis False assms(1) assms(2) assms(3) get_parent_child_dual) then show ?thesis - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ \h \ get_parent child_node \\<^sub>r Some parent\ - get_root_node_parent_same + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ \h \ get_parent child_node \\<^sub>r Some parent\ + get_root_node_parent_same using step.hyps by blast qed - + qed qed end -interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order +interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel get_child_nodes + get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs + get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order using instances by(simp add: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) -locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs - + l_get_root_node_defs + l_heap_is_wellformed_defs + - assumes to_tree_order_get_root_node: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to - \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr +locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs + + l_get_root_node_defs + l_heap_is_wellformed_defs + + assumes to_tree_order_get_root_node: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr \ ptr'' \ set to \ h \ get_root_node ptr'' \\<^sub>r root_ptr" - assumes to_tree_order_same_root: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_root_node ptr \\<^sub>r root_ptr - \ h \ to_tree_order root_ptr \\<^sub>r to \ ptr' \ set to + assumes to_tree_order_same_root: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_root_node ptr \\<^sub>r root_ptr + \ h \ to_tree_order root_ptr \\<^sub>r to \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr" lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [instances]: - "l_to_tree_order_wf_get_root_node_wf type_wf known_ptr known_ptrs to_tree_order + "l_to_tree_order_wf_get_root_node_wf type_wf known_ptr known_ptrs to_tree_order get_root_node heap_is_wellformed" using instances - apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def + apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def l_to_tree_order_wf_get_root_node_wf_axioms_def)[1] using to_tree_order_get_root_node apply blast using to_tree_order_same_root apply blast @@ -2529,7 +2558,7 @@ lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [ 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 @@ -2555,17 +2584,17 @@ proof - by blast have 3: "document_ptr |\| document_ptr_kinds h" using assms(2) get_disconnected_nodes_ptr_in_heap by blast - 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 (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3) - disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent - local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms - returns_result_select_result select_result_I2 type_wf) + have 0: + "\!document_ptr\set |h \ document_ptr_kinds_M|\<^sub>r. node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" + by (metis (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3) + disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent + local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms + returns_result_select_result select_result_I2 type_wf) have "h \ get_parent node_ptr \\<^sub>r None" using heap_is_wellformed_children_disc_nodes_different child_parent_dual assms - using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok - returns_result_select_result split_option_ex + using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok + returns_result_select_result split_option_ex by (metis (no_types, lifting)) then have 4: "h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" @@ -2573,7 +2602,7 @@ proof - by blast obtain document_ptrs where document_ptrs: "h \ document_ptr_kinds_M \\<^sub>r document_ptrs" by simp - + then have "h \ ok (filter_M (\document_ptr. do { disconnected_nodes \ get_disconnected_nodes document_ptr; @@ -2581,7 +2610,7 @@ proof - }) document_ptrs)" using assms(1) get_disconnected_nodes_ok type_wf unfolding heap_is_wellformed_def by(auto intro!: bind_is_OK_I2 filter_M_is_OK_I bind_pure_I) - then obtain candidates where + then obtain candidates where candidates: "h \ filter_M (\document_ptr. do { disconnected_nodes \ get_disconnected_nodes document_ptr; return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) @@ -2589,13 +2618,13 @@ proof - by auto - have eq: "\document_ptr. document_ptr |\| document_ptr_kinds h + have eq: "\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r \ |h \ do { disconnected_nodes \ get_disconnected_nodes document_ptr; return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) }|\<^sub>r" - apply(auto dest!: get_disconnected_nodes_ok[OF type_wf] - intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1] + apply(auto dest!: get_disconnected_nodes_ok[OF type_wf] + intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1] apply(drule select_result_E[where P=id, simplified]) by(auto elim!: bind_returns_result_E2) @@ -2608,8 +2637,8 @@ proof - using eq using local.get_disconnected_nodes_ok apply auto[1] using assms(2) assms(3) - apply(auto intro!: intro!: select_result_I[where P=id, simplified] - elim!: bind_returns_result_E2)[1] + apply(auto intro!: intro!: select_result_I[where P=id, simplified] + elim!: bind_returns_result_E2)[1] using returns_result_eq apply fastforce using document_ptrs 3 apply(simp) using document_ptrs @@ -2619,22 +2648,22 @@ proof - return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) }) document_ptrs \\<^sub>r [document_ptr]" apply(rule filter_M_filter2) - using get_disconnected_nodes_ok document_ptrs 3 assms(1) type_wf filter + using get_disconnected_nodes_ok document_ptrs 3 assms(1) type_wf filter unfolding heap_is_wellformed_def by(auto intro: bind_pure_I bind_is_OK_I2) with 4 document_ptrs have "h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r document_ptr" by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def - intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I - split: option.splits)[1] + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I + split: option.splits)[1] moreover have "known_ptr (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)" using "4" assms(1) known_ptrs type_wf known_ptrs_known_ptr "2" node_ptr_kinds_commutes by blast ultimately show ?thesis using 2 apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ - apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) - apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) apply(drule(1) known_ptr_not_element_ptr) apply(simp add: NodeClass.known_ptr_defs) by(auto split: option.splits intro!: bind_pure_returns_result_I) @@ -2654,11 +2683,12 @@ proof - then have 3: "h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" using assms(2) local.get_root_node_no_parent by blast - have "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" + have "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ +node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" apply(auto)[1] using assms(2) child_parent_dual[OF assms(1)] type_wf - assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3) - returns_result_eq returns_result_select_result + assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3) + returns_result_eq returns_result_select_result by (metis (no_types, hide_lams)) moreover have "node_ptr |\| node_ptr_kinds h" using assms(2) get_parent_ptr_in_heap by blast @@ -2671,12 +2701,12 @@ proof - by auto then show ?thesis using get_owner_document_disconnected_nodes known_ptrs type_wf assms - using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok - returns_result_select_result select_result_I2 + using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok + returns_result_select_result select_result_I2 by (metis (no_types, hide_lams) ) qed -lemma get_owner_document_owner_document_in_heap: +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" @@ -2699,17 +2729,20 @@ next 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" + 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) + 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] + 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 @@ -2722,11 +2755,16 @@ next 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) + 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) + 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" @@ -2739,42 +2777,51 @@ next (\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)) + 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\ + 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 + 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(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) + 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" + 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) + 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] + 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 @@ -2787,11 +2834,17 @@ next 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) + 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) + 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" @@ -2804,14 +2857,19 @@ next (\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)) + 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\ + 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] - using \some_owner_document |\| document_ptr_kinds h\ \root \ cast ` set |h \ get_disconnected_nodes some_owner_document|\<^sub>r\ + 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] - using \some_owner_document |\| document_ptr_kinds h\ \root \ cast ` set |h \ get_disconnected_nodes some_owner_document|\<^sub>r\ + 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] by (simp add: "1" local.get_disconnected_nodes_ok) @@ -2819,17 +2877,19 @@ next 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(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) + 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: +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)" @@ -2841,25 +2901,35 @@ proof - 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 + 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) + 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) + 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(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) + 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(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] + 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 @@ -2870,34 +2940,47 @@ lemma get_owner_document_child_same: 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) + 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 + 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 + 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 + 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) + 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 + 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 + 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 + 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] @@ -2907,13 +2990,18 @@ proof - 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) + 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" + 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) @@ -2937,12 +3025,13 @@ proof - 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] + 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(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) @@ -2956,14 +3045,16 @@ proof - 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) + 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 - + l_get_disconnected_nodes_defs + l_get_owner_document_defs - + l_get_parent_defs + +locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_get_disconnected_nodes_defs + l_get_owner_document_defs + + l_get_parent_defs + assumes get_owner_document_disconnected_nodes: "heap_is_wellformed h \ known_ptrs h \ @@ -2972,26 +3063,30 @@ locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known node_ptr \ set disc_nodes \ h \ get_owner_document (cast node_ptr) \\<^sub>r document_ptr" assumes in_disconnected_nodes_no_parent: - "heap_is_wellformed h \ + "heap_is_wellformed h \ h \ get_parent node_ptr \\<^sub>r None\ h \ get_owner_document (cast node_ptr) \\<^sub>r owner_document \ h \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes \ 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 + 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_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs get_owner_document + 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 + "l_get_owner_document_wf heap_is_wellformed type_wf known_ptr known_ptrs get_disconnected_nodes get_owner_document get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def)[1] @@ -3026,7 +3121,8 @@ proof - 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) + 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] @@ -3035,7 +3131,8 @@ proof - 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) + 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 { @@ -3050,12 +3147,16 @@ proof - 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] + 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 + 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) + 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: @@ -3078,14 +3179,17 @@ proof - 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) + 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) + 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 @@ -3103,10 +3207,12 @@ proof - 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) + 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) + 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)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ @@ -3118,20 +3224,27 @@ proof - 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) + 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)[1] - apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq) + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1] + apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent + local.get_root_node_same_no_parent node_ptr returns_result_eq) using \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)[1] 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)[1] - apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)[1] + apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs + split: option.splits)[1] + apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs + split: option.splits)[1] using \root |\| object_ptr_kinds h\ by(auto simp add: root_node_ptr) qed @@ -3145,9 +3258,12 @@ proof - apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits)+ apply (meson invoke_empty is_OK_returns_result_I) - apply(auto simp add: True a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: if_splits)[1] - apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) - by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3 is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + apply(auto simp add: True a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + split: if_splits)[1] + apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains + is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3 + is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) then show ?thesis using assms(1) assms(2) assms(3) assms(4) get_root_node_document by fastforce @@ -3155,7 +3271,9 @@ proof - 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) + 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" @@ -3165,32 +3283,46 @@ proof - 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)[1] - using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1] + using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent + local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr by fastforce+ then show ?thesis apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ using node_ptr \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) + 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 +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" +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)[1] + "l_get_owner_document_wf_get_root_node_wf heap_is_wellformed type_wf known_ptr known_ptrs +get_root_node get_owner_document" + apply(auto simp add: l_get_owner_document_wf_get_root_node_wf_def + l_get_owner_document_wf_get_root_node_wf_axioms_def instances)[1] using get_root_node_document apply blast using get_root_node_same_owner_document apply (blast, blast) done @@ -3202,8 +3334,8 @@ subsection \set\_attribute\ locale l_set_attribute_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_set_attribute_get_disconnected_nodes + + l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_set_attribute_get_disconnected_nodes + l_set_attribute_get_child_nodes begin lemma set_attribute_preserves_wellformedness: @@ -3213,7 +3345,7 @@ lemma set_attribute_preserves_wellformedness: thm preserves_wellformedness_writes_needed apply(rule preserves_wellformedness_writes_needed[OF assms set_attribute_writes]) using set_attribute_get_child_nodes - apply(fast) + apply(fast) using set_attribute_get_disconnected_nodes apply(fast) by(auto simp add: all_args_def set_attribute_locs_def) end @@ -3239,25 +3371,25 @@ proof - then have "child \ set children" using remove_child remove_child_def by(auto elim!: bind_returns_heap_E dest: returns_result_eq split: if_splits) - then have h1: "\other_ptr other_children. other_ptr \ ptr + then have h1: "\other_ptr other_children. other_ptr \ ptr \ h \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" using assms(1) known_ptrs type_wf child_parent_dual by (meson child_parent_dual children option.inject returns_result_eq) have known_ptr: "known_ptr ptr" using known_ptrs - by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms - remove_child remove_child_ptr_in_heap) + by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms + remove_child remove_child_ptr_in_heap) obtain owner_document disc_nodes h' where - owner_document: "h \ get_owner_document (cast child) \\<^sub>r owner_document" and + owner_document: "h \ get_owner_document (cast child) \\<^sub>r owner_document" and disc_nodes: "h \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" and h': "h \ set_disconnected_nodes owner_document (child # disc_nodes) \\<^sub>h h'" and h2: "h' \ set_child_nodes ptr (remove1 child children) \\<^sub>h h2" using assms children unfolding remove_child_def apply(auto split: if_splits elim!: bind_returns_heap_E)[1] - by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure - get_owner_document_pure pure_returns_heap_eq returns_result_eq) + by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure + get_owner_document_pure pure_returns_heap_eq returns_result_eq) have "object_ptr_kinds h = object_ptr_kinds h2" using remove_child_writes remove_child unfolding remove_child_locs_def @@ -3268,41 +3400,41 @@ proof - unfolding object_ptr_kinds_M_defs by simp have "type_wf h'" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", - OF set_disconnected_nodes_writes h'] + using 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 type_wf by(auto simp add: reflp_def transp_def) have "type_wf h2" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", - OF remove_child_writes remove_child] unfolding remove_child_locs_def - using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", + OF remove_child_writes remove_child] unfolding remove_child_locs_def + using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf apply(auto simp add: reflp_def transp_def)[1] by blast then obtain children' where children': "h2 \ get_child_nodes ptr \\<^sub>r children'" using h2 set_child_nodes_get_child_nodes known_ptr - by (metis \object_ptr_kinds h = object_ptr_kinds h2\ children get_child_nodes_ok - get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I) + by (metis \object_ptr_kinds h = object_ptr_kinds h2\ children get_child_nodes_ok + get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I) have "child \ set children'" - by (metis (mono_tags, lifting) \type_wf h'\ children children' distinct_remove1_removeAll h2 - known_ptr local.heap_is_wellformed_children_distinct - local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2 - wellformed) + by (metis (mono_tags, lifting) \type_wf h'\ children children' distinct_remove1_removeAll h2 + known_ptr local.heap_is_wellformed_children_distinct + local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2 + wellformed) - moreover have "\other_ptr other_children. other_ptr \ ptr + moreover have "\other_ptr other_children. other_ptr \ ptr \ h' \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" proof - fix other_ptr other_children assume a1: "other_ptr \ ptr" and a3: "h' \ get_child_nodes other_ptr \\<^sub>r other_children" have "h \ get_child_nodes other_ptr \\<^sub>r other_children" - using get_child_nodes_reads set_disconnected_nodes_writes h' a3 + using get_child_nodes_reads set_disconnected_nodes_writes h' a3 apply(rule reads_writes_separate_backwards) using set_disconnected_nodes_get_child_nodes by fast show "child \ set other_children" using \h \ get_child_nodes other_ptr \\<^sub>r other_children\ a1 h1 by blast qed - then have "\other_ptr other_children. other_ptr \ ptr + then have "\other_ptr other_children. other_ptr \ ptr \ h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" proof - fix other_ptr other_children @@ -3310,21 +3442,21 @@ proof - have "h' \ get_child_nodes other_ptr \\<^sub>r other_children" using get_child_nodes_reads set_child_nodes_writes h2 a3 apply(rule reads_writes_separate_backwards) - using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers by metis then show "child \ set other_children" - using \\other_ptr other_children. \other_ptr \ ptr; h' \ get_child_nodes other_ptr \\<^sub>r other_children\ + using \\other_ptr other_children. \other_ptr \ ptr; h' \ get_child_nodes other_ptr \\<^sub>r other_children\ \ child \ set other_children\ a1 by blast qed - ultimately have ha: "\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children + ultimately have ha: "\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" by (metis (full_types) children' returns_result_eq) moreover obtain ptrs where ptrs: "h2 \ object_ptr_kinds_M \\<^sub>r ptrs" by (simp add: object_ptr_kinds_M_defs) moreover have "\ptr. ptr \ set ptrs \ h2 \ ok (get_child_nodes ptr)" using \type_wf h2\ ptrs get_child_nodes_ok known_ptr - using \object_ptr_kinds h = object_ptr_kinds h2\ known_ptrs local.known_ptrs_known_ptr by auto - ultimately show "h2 \ get_parent child \\<^sub>r None" + using \object_ptr_kinds h = object_ptr_kinds h2\ known_ptrs local.known_ptrs_known_ptr by auto + ultimately show "h2 \ get_parent child \\<^sub>r None" apply(auto simp add: get_parent_def intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I)[1] proof - have "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child |\| object_ptr_kinds h" @@ -3332,11 +3464,11 @@ proof - then show "h2 \ check_in_heap (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r ()" by (simp add: \object_ptr_kinds h = object_ptr_kinds h2\ check_in_heap_def) next - show "(\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children + show "(\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children) \ ptrs = sorted_list_of_set (fset (object_ptr_kinds h2)) \ (\ptr. ptr |\| object_ptr_kinds h2 \ h2 \ ok get_child_nodes ptr) \ - h2 \ filter_M (\ptr. Heap_Error_Monad.bind (get_child_nodes ptr) + h2 \ filter_M (\ptr. Heap_Error_Monad.bind (get_child_nodes ptr) (\children. return (child \ set children))) (sorted_list_of_set (fset (object_ptr_kinds h2))) \\<^sub>r []" by(auto intro!: filter_M_empty_I bind_pure_I) qed @@ -3358,22 +3490,22 @@ proof (standard, safe) obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr (remove1 child children_h) \\<^sub>h h'" using assms(2) - apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits)[1] + apply(auto simp add: remove_child_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits)[1] using pure_returns_heap_eq by fastforce have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes assms(2)]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have object_ptr_kinds_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" unfolding object_ptr_kinds_M_defs by simp @@ -3387,42 +3519,45 @@ proof (standard, safe) using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" using document_ptr_kinds_M_eq by auto - have children_eq: - "\ptr' children. ptr \ ptr' \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" - apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) + have children_eq: + "\ptr' children. ptr \ ptr' \ +h \ get_child_nodes ptr' \\<^sub>r children =h' \ get_child_nodes ptr' \\<^sub>r children" + apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast - then have children_eq2: + then have children_eq2: "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: - "\document_ptr disconnected_nodes. document_ptr \ owner_document + have disconnected_nodes_eq: + "\document_ptr disconnected_nodes. document_ptr \ owner_document \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" - apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) + apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers by (metis (no_types, lifting) Un_iff owner_document select_result_I2) - then have disconnected_nodes_eq2: - "\document_ptr. document_ptr \ owner_document + then have disconnected_nodes_eq2: + "\document_ptr. document_ptr \ owner_document \ |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes ptr \\<^sub>r children_h" - apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 children_h] ) + apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes + h2 children_h] ) by (simp add: set_disconnected_nodes_get_child_nodes) have "known_ptr ptr" using assms(3) using children_h get_child_nodes_ptr_in_heap local.known_ptrs_known_ptr by blast have "type_wf h2" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes 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 type_wf by(auto simp add: reflp_def transp_def) then have "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_child_nodes_writes h'] - using set_child_nodes_types_preserved + using set_child_nodes_types_preserved by(auto simp add: reflp_def transp_def) have children_h': "h' \ get_child_nodes ptr \\<^sub>r remove1 child children_h" @@ -3450,8 +3585,8 @@ proof (standard, safe) proof (cases "parent = ptr") case True then show ?thesis - using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' - get_child_nodes_ptr_in_heap + using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' + get_child_nodes_ptr_in_heap apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1] by (metis notin_set_remove1) next @@ -3472,22 +3607,22 @@ lemma remove_child_heap_is_wellformed_preserved: proof - obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr (remove1 child children_h) \\<^sub>h h'" using assms(2) apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1] + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1] using pure_returns_heap_eq by fastforce have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes assms(2)]) + OF remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have object_ptr_kinds_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" unfolding object_ptr_kinds_M_defs by simp @@ -3501,29 +3636,31 @@ proof - using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" using document_ptr_kinds_M_eq by auto - have children_eq: - "\ptr' children. ptr \ ptr' \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" - apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) + have children_eq: + "\ptr' children. ptr \ ptr' \ +h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" + apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast - then have children_eq2: - "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" + then have children_eq2: + "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: "\document_ptr disconnected_nodes. document_ptr \ owner_document - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes + have disconnected_nodes_eq: "\document_ptr disconnected_nodes. document_ptr \ owner_document + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" - apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) + apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers by (metis (no_types, lifting) Un_iff owner_document select_result_I2) - then have disconnected_nodes_eq2: - "\document_ptr. document_ptr \ owner_document + then have disconnected_nodes_eq2: + "\document_ptr. document_ptr \ owner_document \ |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes ptr \\<^sub>r children_h" - apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 children_h] ) + apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes + h2 children_h] ) by (simp add: set_disconnected_nodes_get_child_nodes) show "known_ptrs h'" @@ -3532,13 +3669,14 @@ proof - have "known_ptr ptr" using assms(3) using children_h get_child_nodes_ptr_in_heap local.known_ptrs_known_ptr by blast -have "type_wf h2" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h2] + 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 type_wf by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_child_nodes_writes h'] - using set_child_nodes_types_preserved + using set_child_nodes_types_preserved by(auto simp add: reflp_def transp_def) have children_h': "h' \ get_child_nodes ptr \\<^sub>r remove1 child children_h" @@ -3581,8 +3719,8 @@ have "type_wf h2" proof (cases "parent = ptr") case True then show ?thesis - using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' - get_child_nodes_ptr_in_heap + using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' + get_child_nodes_ptr_in_heap apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1] by (metis imageI notin_set_remove1) next @@ -3599,43 +3737,50 @@ 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 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)) + 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'" - apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3 - node_ptr_kinds_eq3)[1] + apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3 + node_ptr_kinds_eq3)[1] proof - fix node_ptr -assume 0: "\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' + 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") case True - show ?thesis + show ?thesis apply(rule exI[where x=owner_document]) using children_eq2 disconnected_nodes_eq2 children_h children_h' disconnected_nodes_h' True - by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I - list.set_intros(1) select_result_I2) + by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I + list.set_intros(1) select_result_I2) next case False then show ?thesis - using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h - disconnected_nodes_h' + using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h + disconnected_nodes_h' apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1] by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2)) qed qed - moreover + moreover { have h0: "a_distinct_lists h" using assms(1) by (simp add: heap_is_wellformed_def) - moreover have ha1: "(\x\set |h \ object_ptr_kinds_M|\<^sub>r. set |h \ get_child_nodes x|\<^sub>r) + moreover have ha1: "(\x\set |h \ object_ptr_kinds_M|\<^sub>r. set |h \ get_child_nodes x|\<^sub>r) \ (\x\set |h \ document_ptr_kinds_M|\<^sub>r. set |h \ get_disconnected_nodes x|\<^sub>r) = {}" using \a_distinct_lists h\ unfolding a_distinct_lists_def @@ -3645,9 +3790,9 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt have ha3: "child \ set |h \ get_child_nodes ptr|\<^sub>r" using child_in_children_h children_h by(simp) - have child_not_in: "\document_ptr. document_ptr |\| document_ptr_kinds h + have child_not_in: "\document_ptr. document_ptr |\| document_ptr_kinds h \ child \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" - using ha1 ha2 ha3 + using ha1 ha2 ha3 apply(simp) using IntI by fastforce moreover have "distinct |h \ object_ptr_kinds_M|\<^sub>r" @@ -3665,28 +3810,28 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt and 3: "distinct |h \ object_ptr_kinds_M|\<^sub>r" have 4: "distinct (concat ((map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r)))" using 1 by(auto simp add: a_distinct_lists_def) - show "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) + show "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" proof(rule distinct_concat_map_I[OF 3[unfolded object_ptr_kinds_eq2], simplified]) fix x assume 5: "x |\| object_ptr_kinds h'" then have 6: "distinct |h \ get_child_nodes x|\<^sub>r" using 4 distinct_concat_map_E object_ptr_kinds_eq2 by fastforce - obtain children where children: "h \ get_child_nodes x \\<^sub>r children" - and distinct_children: "distinct children" - by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr - object_ptr_kinds_eq3 select_result_I) + obtain children where children: "h \ get_child_nodes x \\<^sub>r children" + and distinct_children: "distinct children" + by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr + object_ptr_kinds_eq3 select_result_I) obtain children' where children': "h' \ get_child_nodes x \\<^sub>r children'" using children children_eq children_h' by fastforce then have "distinct children'" proof (cases "ptr = x") case True - then show ?thesis + then show ?thesis using children distinct_children children_h children_h' by (metis children' distinct_remove1 returns_result_eq) next case False - then show ?thesis + then show ?thesis using children distinct_children children_eq[OF False] using children' distinct_lists_children h0 using select_result_I2 by fastforce @@ -3698,11 +3843,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt fix x y assume 5: "x |\| object_ptr_kinds h'" and 6: "y |\| object_ptr_kinds h'" and 7: "x \ y" obtain children_x where children_x: "h \ get_child_nodes x \\<^sub>r children_x" - by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children_y where children_y: "h \ get_child_nodes y \\<^sub>r children_y" - by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children_x' where children_x': "h' \ get_child_nodes x \\<^sub>r children_x'" using children_eq children_h' children_x by fastforce obtain children_y' where children_y': "h' \ get_child_nodes y \\<^sub>r children_y'" @@ -3751,12 +3896,12 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt assume 2: "distinct |h \ document_ptr_kinds_M|\<^sub>r" then have 4: "distinct (sorted_list_of_set (fset (document_ptr_kinds h')))" by simp - have 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + have 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" using h0 by(simp add: a_distinct_lists_def document_ptr_kinds_eq3) - show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" proof(rule distinct_concat_map_I[OF 4[unfolded document_ptr_kinds_eq3]]) fix x @@ -3774,7 +3919,7 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt by(simp) ultimately show ?thesis using 5 unfolding True - by simp + by simp next case False show ?thesis @@ -3796,11 +3941,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt obtain disc_nodes_y' where disc_nodes_y': "h' \ get_disconnected_nodes y \\<^sub>r disc_nodes_y'" using 5 get_disconnected_nodes_ok[OF \type_wf h'\, of y] document_ptr_kinds_eq2 by auto - have "distinct + have "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using h0 by (simp add: a_distinct_lists_def) then have 6: "set disc_nodes_x \ set disc_nodes_y = {}" - using \x \ y\ assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent + using \x \ y\ assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent by blast have "set disc_nodes_x' \ set disc_nodes_y' = {}" @@ -3809,10 +3954,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt then have "y \ owner_document" using \x \ y\ by simp then have "disc_nodes_y' = disc_nodes_y" - using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' + using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' by auto have "disc_nodes_x' = child # disc_nodes_x" - using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h returns_result_eq + using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h + returns_result_eq by fastforce have "child \ set disc_nodes_y" using child_not_in disc_nodes_y 5 @@ -3826,9 +3972,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt proof (cases "y = owner_document") case True then have "disc_nodes_x' = disc_nodes_x" - using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' by auto + using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' + by auto have "disc_nodes_y' = child # disc_nodes_y" - using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h returns_result_eq + using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h + returns_result_eq by fastforce have "child \ set disc_nodes_x" using child_not_in disc_nodes_x 4 @@ -3839,10 +3987,12 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt next case False have "disc_nodes_x' = disc_nodes_x" - using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' by auto + using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' + by auto have "disc_nodes_y' = disc_nodes_y" - using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' by auto - then show ?thesis + using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' + by auto + then show ?thesis apply(unfold \disc_nodes_y' = disc_nodes_y\ \disc_nodes_x' = disc_nodes_x\) using 6 by auto qed @@ -3851,27 +4001,27 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt using disc_nodes_x' disc_nodes_y' by auto qed next -fix x xa xb -assume 1: "xa \ fset (object_ptr_kinds h')" - and 2: "x \ set |h' \ get_child_nodes xa|\<^sub>r" - and 3: "xb \ fset (document_ptr_kinds h')" - and 4: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" + fix x xa xb + assume 1: "xa \ fset (object_ptr_kinds h')" + and 2: "x \ set |h' \ get_child_nodes xa|\<^sub>r" + and 3: "xb \ fset (document_ptr_kinds h')" + and 4: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" obtain disc_nodes where disc_nodes: "h \ get_disconnected_nodes xb \\<^sub>r disc_nodes" using 3 get_disconnected_nodes_ok[OF \type_wf h\, of xb] document_ptr_kinds_eq2 by auto obtain disc_nodes' where disc_nodes': "h' \ get_disconnected_nodes xb \\<^sub>r disc_nodes'" using 3 get_disconnected_nodes_ok[OF \type_wf h'\, of xb] document_ptr_kinds_eq2 by auto obtain children where children: "h \ get_child_nodes xa \\<^sub>r children" - by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children' where children': "h' \ get_child_nodes xa \\<^sub>r children'" using children children_eq children_h' by fastforce have "\x. x \ set |h \ get_child_nodes xa|\<^sub>r \ x \ set |h \ get_disconnected_nodes xb|\<^sub>r \ False" - using 1 3 - apply(fold \ object_ptr_kinds h = object_ptr_kinds h'\) - apply(fold \ document_ptr_kinds h = document_ptr_kinds h'\) + using 1 3 + apply(fold \ object_ptr_kinds h = object_ptr_kinds h'\) + apply(fold \ document_ptr_kinds h = document_ptr_kinds h'\) using children disc_nodes h0 apply(auto simp add: a_distinct_lists_def)[1] - by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2) + by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2) then have 5: "\x. x \ set children \ x \ set disc_nodes \ False" using children disc_nodes by fastforce have 6: "|h' \ get_child_nodes xa|\<^sub>r = children'" @@ -3890,29 +4040,29 @@ assume 1: "xa \ fset (object_ptr_kinds h')" using True children children_h by auto show ?thesis using disc_nodes' children' 5 2 4 children_h \distinct children_h\ disconnected_nodes_h' - apply(auto simp add: 6 7 - \xa = ptr\ \|h' \ get_child_nodes ptr|\<^sub>r = remove1 child children_h\ \children = children_h\)[1] - by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h - select_result_I2 set_ConsD) + apply(auto simp add: 6 7 + \xa = ptr\ \|h' \ get_child_nodes ptr|\<^sub>r = remove1 child children_h\ \children = children_h\)[1] + by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h + select_result_I2 set_ConsD) next case False have "children' = children" using children' children children_eq[OF False[symmetric]] - by auto + by auto then show ?thesis proof (cases "xb = owner_document") case True then show ?thesis using disc_nodes disconnected_nodes_h disconnected_nodes_h' - using "2" "4" "5" "6" "7" False \children' = children\ assms(1) child_in_children_h - child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap - list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD + using "2" "4" "5" "6" "7" False \children' = children\ assms(1) child_in_children_h + child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap + list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD by (metis (no_types, hide_lams) assms(3) type_wf) next case False then show ?thesis - using "2" "4" "5" "6" "7" \children' = children\ disc_nodes disc_nodes' - disconnected_nodes_eq returns_result_eq + using "2" "4" "5" "6" "7" \children' = children\ disc_nodes disc_nodes' + disconnected_nodes_eq returns_result_eq by metis qed qed @@ -3932,33 +4082,34 @@ lemma remove_heap_is_wellformed_preserved: 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) + 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'" and children: "h' \ get_child_nodes ptr \\<^sub>r children" -and known_ptrs: "known_ptrs h" -and type_wf: "type_wf h" -shows "child \ set children" + and known_ptrs: "known_ptrs h" + and type_wf: "type_wf h" + shows "child \ set children" proof - obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr' \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr' \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr' (remove1 child children_h) \\<^sub>h h'" using assms(2) - apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits)[1] + apply(auto simp add: remove_child_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits)[1] using pure_returns_heap_eq by fastforce have "object_ptr_kinds h = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes remove_child]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes remove_child]) unfolding remove_child_locs_def using set_child_nodes_pointers_preserved set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) @@ -3970,8 +4121,8 @@ proof - by blast ultimately show ?thesis using remove_child_removes_parent remove_child_heap_is_wellformed_preserved child_parent_dual - by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child - returns_result_eq type_wf wellformed) + by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child + returns_result_eq type_wf wellformed) qed lemma remove_child_removes_first_child: @@ -3986,16 +4137,16 @@ proof - h2: "h \ set_disconnected_nodes owner_document (node_ptr # disc_nodes) \\<^sub>h h2" and "h2 \ set_child_nodes ptr children \\<^sub>h h'" using assms(5) - apply(auto simp add: remove_child_def - dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1] + apply(auto simp add: remove_child_def + dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1] by(auto elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]) + bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]) have "known_ptr ptr" by (meson assms(3) assms(4) is_OK_returns_result_I get_child_nodes_ptr_in_heap known_ptrs_known_ptr) moreover have "h2 \ get_child_nodes ptr \\<^sub>r node_ptr # children" apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 assms(4)]) - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast moreover have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h2] @@ -4016,9 +4167,9 @@ proof - using child_parent_dual assms by fastforce show ?thesis using assms remove_child_removes_first_child - by(auto simp add: remove_def - dest!: bind_returns_heap_E3[rotated, OF \h \ get_parent node_ptr \\<^sub>r Some ptr\, rotated] - bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated]) + by(auto simp add: remove_def + dest!: bind_returns_heap_E3[rotated, OF \h \ get_parent node_ptr \\<^sub>r Some ptr\, rotated] + bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated]) qed lemma remove_for_all_empty_children: @@ -4029,7 +4180,7 @@ lemma remove_for_all_empty_children: using assms proof(induct children arbitrary: h h') case Nil - then show ?case + then show ?case by simp next case (Cons a children) @@ -4038,8 +4189,8 @@ next with Cons show ?case proof(auto elim!: bind_returns_heap_E)[1] fix h2 - assume 0: "(\h h'. heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r children + assume 0: "(\h h'. heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r children \ h \ forall_M remove children \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r [])" and 1: "heap_is_wellformed h" and 2: "type_wf h" @@ -4054,17 +4205,17 @@ next moreover have "heap_is_wellformed h2" using 7 1 2 3 remove_child_heap_is_wellformed_preserved(3) by(auto simp add: remove_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - split: option.splits) + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + split: option.splits) moreover have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_writes 7] using \type_wf h\ remove_child_types_preserved by(auto simp add: a_remove_child_locs_def reflp_def transp_def) moreover have "object_ptr_kinds h = object_ptr_kinds h2" using 7 - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_writes]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_writes]) using remove_child_pointers_preserved by (auto simp add: reflp_def transp_def) then have "known_ptrs h2" @@ -4076,22 +4227,22 @@ next qed end -locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_remove_defs + - assumes remove_child_preserves_type_wf: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' +locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_remove_defs + + assumes remove_child_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' \ type_wf h'" - assumes remove_child_preserves_known_ptrs: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' + assumes remove_child_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' \ known_ptrs 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' + 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' + 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' @@ -4100,27 +4251,27 @@ locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_h "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 \ child \ set children" - assumes remove_child_removes_first_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children - \ h \ remove_child ptr node_ptr \\<^sub>h h' + assumes remove_child_removes_first_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children + \ h \ remove_child ptr node_ptr \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children" - assumes remove_removes_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children + assumes remove_removes_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children \ h \ remove node_ptr \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children" - assumes remove_for_all_empty_children: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children + assumes remove_for_all_empty_children: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children \ h \ forall_M remove children \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r []" -interpretation i_remove_child_wf2?: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs - set_child_nodes set_child_nodes_locs get_parent get_parent_locs get_owner_document - get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel +interpretation i_remove_child_wf2?: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs + set_child_nodes set_child_nodes_locs get_parent get_parent_locs get_owner_document + get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel by unfold_locales -lemma remove_child_wf2_is_l_remove_child_wf2 [instances]: +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) @@ -4130,11 +4281,11 @@ lemma remove_child_wf2_is_l_remove_child_wf2 [instances]: using remove_removes_child apply fast using remove_for_all_empty_children apply fast done - + 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 + @@ -4151,7 +4302,7 @@ proof - obtain old_document parent_opt h2 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 } + 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; @@ -4160,22 +4311,22 @@ proof - 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]) + by(auto simp add: adopt_node_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) have "h2 \ get_child_nodes ptr' \\<^sub>r children" using h2 remove_child_removes_first_child assms(1) assms(2) assms(3) assms(5) by (metis list.set_intros(1) local.child_parent_dual option.simps(5) parent_opt returns_result_eq) then show ?thesis using h' - by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes] - split: if_splits) + by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes] + split: if_splits) qed -lemma adopt_node_document_in_heap: +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" @@ -4183,7 +4334,7 @@ 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" + 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; @@ -4192,10 +4343,10 @@ proof - 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]) + 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 @@ -4211,21 +4362,21 @@ proof - 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] ) + 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'", + 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'", + 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 + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) ultimately show ?thesis @@ -4233,7 +4384,7 @@ proof - qed qed end - + locale l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + @@ -4256,37 +4407,37 @@ proof - old_document: "h \ get_owner_document (cast node_ptr) \\<^sub>r old_document" and parent_opt: "h \ get_parent node_ptr \\<^sub>r parent_opt" and h': "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return () ) \\<^sub>h h'" - using adopt_node get_parent_pure + using adopt_node get_parent_pure by(auto simp add: adopt_node_def - elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - split: if_splits) + elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + split: if_splits) then have "h' \ get_child_nodes ptr \\<^sub>r children" - using adopt_node - apply(auto simp add: adopt_node_def - dest!: bind_returns_heap_E3[rotated, OF old_document, rotated] - bind_returns_heap_E3[rotated, OF parent_opt, rotated] - elim!: bind_returns_heap_E4[rotated, OF h', rotated])[1] - apply(auto split: if_splits - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] - apply (simp add: set_disconnected_nodes_get_child_nodes children - reads_writes_preserved[OF get_child_nodes_reads set_disconnected_nodes_writes]) + using adopt_node + apply(auto simp add: adopt_node_def + dest!: bind_returns_heap_E3[rotated, OF old_document, rotated] + bind_returns_heap_E3[rotated, OF parent_opt, rotated] + elim!: bind_returns_heap_E4[rotated, OF h', rotated])[1] + apply(auto split: if_splits + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] + apply (simp add: set_disconnected_nodes_get_child_nodes children + reads_writes_preserved[OF get_child_nodes_reads set_disconnected_nodes_writes]) using children by blast show ?thesis proof(insert parent_opt h', induct parent_opt) case None then show ?case - using child_parent_dual wellformed known_ptrs type_wf - \h' \ get_child_nodes ptr \\<^sub>r children\ returns_result_eq + using child_parent_dual wellformed known_ptrs type_wf + \h' \ get_child_nodes ptr \\<^sub>r children\ returns_result_eq by fastforce next case (Some option) then show ?case - using remove_child_removes_child \h' \ get_child_nodes ptr \\<^sub>r children\ known_ptrs type_wf - wellformed + using remove_child_removes_child \h' \ get_child_nodes ptr \\<^sub>r children\ known_ptrs type_wf + wellformed by auto qed qed @@ -4294,7 +4445,7 @@ qed lemma adopt_node_removes_child: 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'. + shows "\ptr' children'. h' \ get_child_nodes ptr' \\<^sub>r children' \ node_ptr \ set children'" using adopt_node_removes_child_step assms by blast @@ -4306,12 +4457,12 @@ lemma adopt_node_preserves_wellformedness: 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" - and - parent_opt: "h \ get_parent child \\<^sub>r parent_opt" - and - h2: "h \ (case parent_opt of Some parent \ remove_child parent child | None \ return ()) \\<^sub>h h2" - and + old_document: "h \ get_owner_document (cast child) \\<^sub>r old_document" + and + parent_opt: "h \ get_parent child \\<^sub>r parent_opt" + and + h2: "h \ (case parent_opt of Some parent \ remove_child parent child | None \ return ()) \\<^sub>h h2" + and h': "h2 \ (if document_ptr \ old_document then do { old_disc_nodes \ get_disconnected_nodes old_document; set_disconnected_nodes old_document (remove1 child old_disc_nodes); @@ -4321,18 +4472,18 @@ proof - return () }) \\<^sub>h h'" using assms(2) - by(auto simp add: adopt_node_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_parent_pure]) + by(auto simp add: adopt_node_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) have object_ptr_kinds_h_eq3: "object_ptr_kinds h = object_ptr_kinds h2" using h2 apply(simp split: option.splits) - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes]) using remove_child_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h2 \ object_ptr_kinds_M \\<^sub>r ptrs" + 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" unfolding object_ptr_kinds_M_defs by simp then have object_ptr_kinds_eq_h: "|h \ object_ptr_kinds_M|\<^sub>r = |h2 \ object_ptr_kinds_M|\<^sub>r" by simp @@ -4341,13 +4492,13 @@ 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) + by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) have "type_wf h2" using h2 remove_child_preserves_type_wf known_ptrs type_wf - by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) + 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) + 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 @@ -4359,20 +4510,20 @@ proof - docs_neq: "document_ptr \ old_document" and old_disc_nodes: "h2 \ get_disconnected_nodes old_document \\<^sub>r old_disc_nodes" and h3: "h2 \ set_disconnected_nodes old_document (remove1 child old_disc_nodes) \\<^sub>h h3" and - disc_nodes_document_ptr_h3: - "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" and + disc_nodes_document_ptr_h3: + "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" and h': "h3 \ set_disconnected_nodes document_ptr (child # disc_nodes_document_ptr_h3) \\<^sub>h h'" using h' - by(auto elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + by(auto elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) have object_ptr_kinds_h2_eq3: "object_ptr_kinds h2 = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes h3]) - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + 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" + 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) @@ -4384,7 +4535,7 @@ proof - 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: + 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) @@ -4393,11 +4544,11 @@ proof - using select_result_eq by force have object_ptr_kinds_h3_eq3: "object_ptr_kinds h3 = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes h']) - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF set_disconnected_nodes_writes h']) + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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_eq_h3: "|h3 \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" @@ -4410,7 +4561,7 @@ proof - using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3_h3: "document_ptr_kinds h3 = document_ptr_kinds h'" using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto - have children_eq_h3: + have children_eq_h3: "\ptr children. h3 \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) @@ -4418,25 +4569,25 @@ proof - then have children_eq2_h3: "\ptr. |h3 \ get_child_nodes ptr|\<^sub>r = |h' \ get_child_nodes ptr|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. old_document \ doc_ptr + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. old_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 (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h2: - "\doc_ptr. old_document \ doc_ptr + then have disconnected_nodes_eq2_h2: + "\doc_ptr. old_document \ doc_ptr \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2: + obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2: "h2 \ get_disconnected_nodes old_document \\<^sub>r disc_nodes_old_document_h2" using old_disc_nodes by blast then have disc_nodes_old_document_h3: "h3 \ get_disconnected_nodes old_document \\<^sub>r remove1 child disc_nodes_old_document_h2" - using h3 old_disc_nodes returns_result_eq set_disconnected_nodes_get_disconnected_nodes + using h3 old_disc_nodes returns_result_eq set_disconnected_nodes_get_disconnected_nodes by fastforce have "distinct disc_nodes_old_document_h2" - using disc_nodes_old_document_h2 local.heap_is_wellformed_disconnected_nodes_distinct wellformed_h2 + using disc_nodes_old_document_h2 local.heap_is_wellformed_disconnected_nodes_distinct wellformed_h2 by blast @@ -4448,35 +4599,38 @@ proof - next case (Some option) then show ?case - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_child_writes] - type_wf remove_child_types_preserved + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_child_writes] + type_wf remove_child_types_preserved by (simp add: reflp_def transp_def) qed then have "type_wf h3" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h3] - using set_disconnected_nodes_types_preserved + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", + OF set_disconnected_nodes_writes h3] + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) then have "type_wf h'" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", + OF set_disconnected_nodes_writes h'] + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) have "known_ptrs h3" - using known_ptrs local.known_ptrs_preserved object_ptr_kinds_h2_eq3 object_ptr_kinds_h_eq3 by blast + 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 + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: - "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: + "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: + have disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" using disconnected_nodes_eq_h2 docs_neq disc_nodes_document_ptr_h3 by auto have disc_nodes_document_ptr_h': " @@ -4487,11 +4641,11 @@ proof - have document_ptr_in_heap: "document_ptr |\| document_ptr_kinds h2" using disc_nodes_document_ptr_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1) unfolding heap_is_wellformed_def - using disc_nodes_document_ptr_h2 get_disconnected_nodes_ptr_in_heap by blast + using disc_nodes_document_ptr_h2 get_disconnected_nodes_ptr_in_heap by blast have old_document_in_heap: "old_document |\| document_ptr_kinds h2" using disc_nodes_old_document_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1) unfolding heap_is_wellformed_def - using get_disconnected_nodes_ptr_in_heap old_disc_nodes by blast + using get_disconnected_nodes_ptr_in_heap old_disc_nodes by blast have "child \ set disc_nodes_old_document_h2" proof (insert parent_opt h2, induct parent_opt) @@ -4500,36 +4654,37 @@ proof - by(auto) moreover have "a_owner_document_valid h" using assms(1) heap_is_wellformed_def by(simp add: heap_is_wellformed_def) - ultimately show ?case - using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)] - in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast + ultimately show ?case + using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)] + in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast next case (Some option) then show ?case apply(simp split: option.splits) - using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes known_ptrs + using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes + known_ptrs by blast qed have "child \ set (remove1 child disc_nodes_old_document_h2)" - using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2 \distinct disc_nodes_old_document_h2\ + using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2 \distinct disc_nodes_old_document_h2\ by auto have "child \ set disc_nodes_document_ptr_h3" proof - have "a_distinct_lists h2" using heap_is_wellformed_def wellformed_h2 by blast - then have 0: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + then have 0: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) |h2 \ document_ptr_kinds_M|\<^sub>r))" by(simp add: a_distinct_lists_def) show ?thesis - using distinct_concat_map_E(1)[OF 0] \child \ set disc_nodes_old_document_h2\ - disc_nodes_old_document_h2 disc_nodes_document_ptr_h2 - by (meson \type_wf h2\ docs_neq known_ptrs local.get_owner_document_disconnected_nodes - local.known_ptrs_preserved object_ptr_kinds_h_eq3 returns_result_eq wellformed_h2) + using distinct_concat_map_E(1)[OF 0] \child \ set disc_nodes_old_document_h2\ + disc_nodes_old_document_h2 disc_nodes_document_ptr_h2 + by (meson \type_wf h2\ docs_neq known_ptrs local.get_owner_document_disconnected_nodes + local.known_ptrs_preserved object_ptr_kinds_h_eq3 returns_result_eq wellformed_h2) qed have child_in_heap: "child |\| node_ptr_kinds h" - using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]] - node_ptr_kinds_commutes by blast + using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]] + node_ptr_kinds_commutes by blast have "a_acyclic_heap h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) have "parent_child_rel h' \ parent_child_rel h2" @@ -4537,8 +4692,8 @@ proof - fix x assume "x \ parent_child_rel h'" then show "x \ parent_child_rel h2" - using object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3 - mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong + using object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3 + mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong unfolding parent_child_rel_def by(simp) qed @@ -4550,39 +4705,47 @@ proof - then have "a_all_ptrs_in_heap h3" apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1] apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1)) - by (metis (no_types, lifting) \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'" + 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] - 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) + 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) then have "a_owner_document_valid h'" - apply(simp add: a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3 - object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 children_eq2_h2 children_eq2_h3 ) - by (smt disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 - disc_nodes_old_document_h2 disc_nodes_old_document_h3 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_in_heap - document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 in_set_remove1 - list.set_intros(1) list.set_intros(2) node_ptr_kinds_eq3_h2 - node_ptr_kinds_eq3_h3 object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 - select_result_I2) + apply(simp add: a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3 + object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 children_eq2_h2 children_eq2_h3 ) + by (smt disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 + disc_nodes_old_document_h2 disc_nodes_old_document_h3 + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_in_heap + document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 in_set_remove1 + list.set_intros(1) list.set_intros(2) node_ptr_kinds_eq3_h2 + node_ptr_kinds_eq3_h3 object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 + select_result_I2) have a_distinct_lists_h2: "a_distinct_lists h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h'" - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2 - children_eq2_h2 children_eq2_h3)[1] + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2 + children_eq2_h2 children_eq2_h3)[1] proof - assume 1: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" - and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h2)))))" - and 3: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + and 3: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h2). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" - show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" proof(rule distinct_concat_map_I) show "distinct (sorted_list_of_set (fset (document_ptr_kinds h')))" @@ -4591,32 +4754,32 @@ proof - fix x assume a1: "x \ set (sorted_list_of_set (fset (document_ptr_kinds h')))" have 4: "distinct |h2 \ get_disconnected_nodes x|\<^sub>r" - using a_distinct_lists_h2 "2" a1 concat_map_all_distinct document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 + using a_distinct_lists_h2 "2" a1 concat_map_all_distinct document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 by fastforce then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" proof (cases "old_document \ x") case True - then show ?thesis + then show ?thesis proof (cases "document_ptr \ x") case True - then show ?thesis - using disconnected_nodes_eq2_h2[OF \old_document \ x\] - disconnected_nodes_eq2_h3[OF \document_ptr \ x\] 4 + then show ?thesis + using disconnected_nodes_eq2_h2[OF \old_document \ x\] + disconnected_nodes_eq2_h3[OF \document_ptr \ x\] 4 by(auto) next case False - then show ?thesis + then show ?thesis using disc_nodes_document_ptr_h3 disc_nodes_document_ptr_h' 4 - \child \ set disc_nodes_document_ptr_h3\ + \child \ set disc_nodes_document_ptr_h3\ by(auto simp add: disconnected_nodes_eq2_h2[OF \old_document \ x\] ) qed next case False then show ?thesis - by (metis (no_types, hide_lams) \distinct disc_nodes_old_document_h2\ - disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 - distinct_remove1 docs_neq select_result_I2) + by (metis (no_types, hide_lams) \distinct disc_nodes_old_document_h2\ + disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 + distinct_remove1 docs_neq select_result_I2) qed next fix x y @@ -4625,7 +4788,7 @@ proof - and a2: "x \ y" moreover have 5: "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes y|\<^sub>r = {}" - using 2 calculation + using 2 calculation by (auto simp add: document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 dest: distinct_concat_map_E(1)) ultimately show "set |h' \ get_disconnected_nodes x|\<^sub>r \ set |h' \ get_disconnected_nodes y|\<^sub>r = {}" proof(cases "old_document = x") @@ -4638,21 +4801,21 @@ proof - proof(cases "document_ptr = y") case True then show ?thesis - using 5 True select_result_I2[OF disc_nodes_document_ptr_h'] + using 5 True select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] select_result_I2[OF disc_nodes_old_document_h2] select_result_I2[OF disc_nodes_old_document_h3] \old_document = x\ by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ - \document_ptr \ x\ disconnected_nodes_eq2_h3 disjoint_iff_not_equal - notin_set_remove1 set_ConsD) + \document_ptr \ x\ disconnected_nodes_eq2_h3 disjoint_iff_not_equal + notin_set_remove1 set_ConsD) next case False - then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + then show ?thesis + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h2] select_result_I2[OF disc_nodes_old_document_h3] - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \old_document = x\ + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \old_document = x\ docs_neq \old_document \ y\ by (metis (no_types, lifting) disjoint_iff_not_equal notin_set_remove1) qed @@ -4665,49 +4828,49 @@ proof - proof(cases "document_ptr = x") case True show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] - \old_document \ x\ \old_document = y\ \document_ptr = x\ - apply(simp) - by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ - disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1) + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + select_result_I2[OF disc_nodes_document_ptr_h2] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] + \old_document \ x\ \old_document = y\ \document_ptr = x\ + apply(simp) + by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ + disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1) next case False then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] - \old_document \ x\ \old_document = y\ \document_ptr \ x\ - by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 - disjoint_iff_not_equal docs_neq notin_set_remove1) + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + select_result_I2[OF disc_nodes_document_ptr_h2] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] + \old_document \ x\ \old_document = y\ \document_ptr \ x\ + by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 + disjoint_iff_not_equal docs_neq notin_set_remove1) qed next case False have "set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}" by (metis DocumentMonad.ptr_kinds_M_ok DocumentMonad.ptr_kinds_M_ptr_kinds False - \type_wf h2\ a1 disc_nodes_old_document_h2 document_ptr_kinds_M_def - document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok - local.heap_is_wellformed_one_disc_parent returns_result_select_result - wellformed_h2) + \type_wf h2\ a1 disc_nodes_old_document_h2 document_ptr_kinds_M_def + document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok + local.heap_is_wellformed_one_disc_parent returns_result_select_result + wellformed_h2) then show ?thesis proof(cases "document_ptr = x") case True then have "document_ptr \ y" using \x \ y\ by auto have "set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}" - using \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ + using \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ by blast - then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + then show ?thesis + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] \old_document \ x\ \old_document \ y\ \document_ptr = x\ \document_ptr \ y\ - \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ by(auto) @@ -4717,33 +4880,33 @@ proof - proof(cases "document_ptr = y") case True have f1: "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set disc_nodes_document_ptr_h3 = {}" - using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - \document_ptr \ x\ select_result_I2[OF disc_nodes_document_ptr_h3, symmetric] - disconnected_nodes_eq2_h2[OF docs_neq[symmetric], symmetric] + using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + \document_ptr \ x\ select_result_I2[OF disc_nodes_document_ptr_h3, symmetric] + disconnected_nodes_eq2_h2[OF docs_neq[symmetric], symmetric] by (simp add: "5" True) - moreover have f1: - "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes old_document|\<^sub>r = {}" - using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - \old_document \ x\ - by (metis (no_types, lifting) a0 distinct_concat_map_E(1) document_ptr_kinds_eq3_h2 - document_ptr_kinds_eq3_h3 finite_fset fmember.rep_eq set_sorted_list_of_set) + moreover have f1: + "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes old_document|\<^sub>r = {}" + using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + \old_document \ x\ + by (metis (no_types, lifting) a0 distinct_concat_map_E(1) document_ptr_kinds_eq3_h2 + document_ptr_kinds_eq3_h3 finite_fset fmember.rep_eq set_sorted_list_of_set) ultimately show ?thesis using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ + select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ \document_ptr \ x\ \document_ptr = y\ - \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 - disconnected_nodes_eq2_h3 + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 + disconnected_nodes_eq2_h3 by auto next case False then show ?thesis - using 5 - select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ + using 5 + select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ \document_ptr \ x\ \document_ptr \ y\ - \child \ set disc_nodes_old_document_h2\ + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 - by (metis \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ - empty_iff inf.idem) + by (metis \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ + empty_iff inf.idem) qed qed qed @@ -4751,21 +4914,21 @@ proof - qed next fix x xa xb - assume 0: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) + assume 0: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" - and 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h2)))))" - and 2: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + and 2: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h2). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" - and 3: "xa |\| object_ptr_kinds h'" - and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" - and 5: "xb |\| document_ptr_kinds h'" - and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" + and 3: "xa |\| object_ptr_kinds h'" + and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" + and 5: "xb |\| document_ptr_kinds h'" + and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" then show False using \child \ set disc_nodes_old_document_h2\ disc_nodes_document_ptr_h' - disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 old_document_in_heap + disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3 + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 old_document_in_heap apply(auto)[1] apply(cases "xb = old_document") proof - @@ -4774,19 +4937,19 @@ proof - assume a3: "h3 \ get_disconnected_nodes old_document \\<^sub>r remove1 child disc_nodes_old_document_h2" assume a4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" assume "document_ptr_kinds h2 = document_ptr_kinds h'" - assume a5: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + assume a5: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" have f6: "old_document |\| document_ptr_kinds h'" using a1 \xb |\| document_ptr_kinds h'\ by blast have f7: "|h2 \ get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2" using a2 by simp have "x \ set disc_nodes_old_document_h2" - using f6 a3 a1 by (metis (no_types) \type_wf h'\ \x \ set |h' \ get_disconnected_nodes xb|\<^sub>r\ - disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq - returns_result_select_result set_remove1_subset subsetCE) + using f6 a3 a1 by (metis (no_types) \type_wf h'\ \x \ set |h' \ get_disconnected_nodes xb|\<^sub>r\ + disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq + returns_result_select_result set_remove1_subset subsetCE) then have "set |h' \ get_child_nodes xa|\<^sub>r \ set |h2 \ get_disconnected_nodes xb|\<^sub>r = {}" using f7 f6 a5 a4 \xa |\| object_ptr_kinds h'\ - by fastforce + by fastforce then show ?thesis using \x \ set disc_nodes_old_document_h2\ a1 a4 f7 by blast next @@ -4799,11 +4962,11 @@ proof - assume a7: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" assume a8: "x \ set |h' \ get_child_nodes xa|\<^sub>r" assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'" - assume a10: "\doc_ptr. old_document \ doc_ptr + assume a10: "\doc_ptr. old_document \ doc_ptr \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" - assume a11: "\doc_ptr. document_ptr \ doc_ptr + assume a11: "\doc_ptr. document_ptr \ doc_ptr \ |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" - assume a12: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + assume a12: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" have f13: "\d. d \ set |h' \ document_ptr_kinds_M|\<^sub>r \ h2 \ ok get_disconnected_nodes d" using a9 \type_wf h2\ get_disconnected_nodes_ok @@ -4815,12 +4978,12 @@ proof - by (meson UN_I disjoint_iff_not_equal fmember.rep_eq) then have "x = child" using f13 a11 a10 a7 a5 a2 a1 - by (metis (no_types, lifting) select_result_I2 set_ConsD) + by (metis (no_types, lifting) select_result_I2 set_ConsD) then have "child \ set disc_nodes_old_document_h2" using f14 a12 a8 a6 a4 - by (metis \type_wf h'\ adopt_node_removes_child assms(1) assms(2) type_wf - get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3 - object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result) + by (metis \type_wf h'\ adopt_node_removes_child assms(1) assms(2) type_wf + get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3 + object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result) then show ?thesis using \child \ set disc_nodes_old_document_h2\ by fastforce qed @@ -4843,7 +5006,7 @@ proof - obtain old_document parent_opt h2 where old_document: "h \ get_owner_document (cast node_ptr) \\<^sub>r old_document" and parent_opt: "h \ get_parent node_ptr \\<^sub>r parent_opt" and - h2: "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return ()) \\<^sub>h h2" + h2: "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return ()) \\<^sub>h h2" and h': "h2 \ (if owner_document \ old_document then do { old_disc_nodes \ get_disconnected_nodes old_document; @@ -4854,9 +5017,9 @@ proof - return () }) \\<^sub>h h'" using assms(2) - by(auto simp add: adopt_node_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_parent_pure]) + 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") @@ -4879,9 +5042,9 @@ proof - using assms(3) h' list.set_intros(1) select_result_I2 set_disconnected_nodes_get_disconnected_nodes apply(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] proof - - fix x and h'a and xb + fix x and h'a and xb assume a1: "h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" - assume a2: "\h document_ptr disc_nodes h'. h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' + assume a2: "\h document_ptr disc_nodes h'. h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' \ h' \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assume "h'a \ set_disconnected_nodes owner_document (node_ptr # xb) \\<^sub>h h'" then have "node_ptr # xb = disc_nodes" @@ -4893,52 +5056,52 @@ proof - qed end -interpretation i_adopt_node_wf?: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs - remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr - type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs - remove heap_is_wellformed parent_child_rel +interpretation i_adopt_node_wf?: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs + remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr + type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs + remove heap_is_wellformed parent_child_rel by(simp add: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -interpretation i_adopt_node_wf2?: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs - remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr - type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs - remove heap_is_wellformed parent_child_rel get_root_node get_root_node_locs +interpretation i_adopt_node_wf2?: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs + remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr + type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs + remove heap_is_wellformed parent_child_rel get_root_node get_root_node_locs by(simp add: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs - + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + +locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs + + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + assumes adopt_node_preserves_wellformedness: - "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h + "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h \ type_wf h \ heap_is_wellformed h'" assumes adopt_node_removes_child: - "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h2 - \ h2 \ get_child_nodes ptr \\<^sub>r children \ known_ptrs h + "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h2 + \ h2 \ get_child_nodes ptr \\<^sub>r children \ known_ptrs h \ type_wf h \ node_ptr \ set children" assumes adopt_node_node_in_disconnected_nodes: - "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h' - \ h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes + "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h' + \ h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes \ known_ptrs h \ type_wf h \ node_ptr \ set disc_nodes" - assumes adopt_node_removes_first_child: "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ adopt_node owner_document node \\<^sub>h h' - \ h \ get_child_nodes ptr' \\<^sub>r node # children + assumes adopt_node_removes_first_child: "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ 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 + "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 + "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]: +lemma adopt_node_wf_is_l_adopt_node_wf [instances]: "l_adopt_node_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes known_ptrs adopt_node" using heap_is_wellformed_is_l_heap_is_wellformed known_ptrs_is_l_known_ptrs @@ -4976,52 +5139,52 @@ proof - h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disc_nodes) \\<^sub>h h3" and h': "h3 \ a_insert_node ptr node reference_child \\<^sub>h h'" using assms(5) - by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - split: if_splits option.splits) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + split: if_splits option.splits) have "h2 \ get_child_nodes ptr' \\<^sub>r children" using h2 adopt_node_removes_first_child assms(1) assms(2) assms(3) assms(6) by simp then have "h3 \ get_child_nodes ptr' \\<^sub>r children" using h3 - by(auto simp add: set_disconnected_nodes_get_child_nodes - dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]) + by(auto simp add: set_disconnected_nodes_get_child_nodes + dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]) then show ?thesis using h' assms(4) - apply(auto simp add: a_insert_node_def - elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1] - by(auto simp add: set_child_nodes_get_child_nodes_different_pointers - elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes]) + apply(auto simp add: a_insert_node_def + elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1] + by(auto simp add: set_child_nodes_get_child_nodes_different_pointers + elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes]) qed end -locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs - + l_insert_before_defs + l_get_child_nodes_defs + -assumes insert_before_removes_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ ptr \ ptr' - \ h \ insert_before ptr node child \\<^sub>h h' - \ h \ get_child_nodes ptr' \\<^sub>r node # children +locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_insert_before_defs + l_get_child_nodes_defs + + assumes insert_before_removes_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ ptr \ ptr' + \ h \ insert_before ptr node child \\<^sub>h h' + \ h \ get_child_nodes ptr' \\<^sub>r node # children \ h' \ get_child_nodes ptr' \\<^sub>r children" -interpretation i_insert_before_wf?: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs - get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_ancestors get_ancestors_locs - adopt_node adopt_node_locs set_disconnected_nodes - set_disconnected_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs get_owner_document insert_before - insert_before_locs append_child type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel +interpretation i_insert_before_wf?: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs + get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_ancestors get_ancestors_locs + adopt_node adopt_node_locs set_disconnected_nodes + set_disconnected_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs get_owner_document insert_before + insert_before_locs append_child type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel by(simp add: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -lemma insert_before_wf_is_l_insert_before_wf [instances]: +lemma insert_before_wf_is_l_insert_before_wf [instances]: "l_insert_before_wf heap_is_wellformed type_wf known_ptr known_ptrs insert_before get_child_nodes" apply(auto simp add: l_insert_before_wf_def l_insert_before_wf_axioms_def instances)[1] using insert_before_removes_child apply fast @@ -5043,37 +5206,37 @@ begin lemma insert_before_preserves_acyclitity: 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')" + 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 + 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 + 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 + 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) + 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) + 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] @@ -5081,18 +5244,18 @@ proof - 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 + 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 + 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]) + 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 + 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 ) @@ -5108,10 +5271,10 @@ proof - 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]) + 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 + 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) @@ -5124,17 +5287,17 @@ proof - 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']) + 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 + using set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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: + 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" @@ -5145,68 +5308,68 @@ proof - 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 + 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 + 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" + 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 + 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: + 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" + 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" + 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' + 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" + 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]) + 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: + 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" + 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" @@ -5214,26 +5377,26 @@ proof - 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 + 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 + 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) + 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 + using disconnected_nodes_eq2_h2[OF False] \node \ set disconnected_nodes_h2\ + disconnected_nodes_h2 by fastforce qed qed - have "cast node \ ptr" + have "cast node \ ptr" using ancestors node_not_in_ancestors get_ancestors_ptr by fast @@ -5243,7 +5406,7 @@ proof - 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 + 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]) @@ -5254,24 +5417,25 @@ proof - 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 "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 + 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(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')" @@ -5289,26 +5453,26 @@ proof - 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 + "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(2) - by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - split: if_splits option.splits) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) have "known_ptr ptr" - by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs - l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) + by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs + l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF adopt_node_writes h2] @@ -5316,18 +5480,18 @@ proof - 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 + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF insert_node_writes h'] - using set_child_nodes_types_preserved + 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]) + 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 + 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 ) @@ -5343,10 +5507,10 @@ proof - using adopt_node_preserves_wellformedness[OF wellformed h2] known_ptrs type_wf . have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes 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 + 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) @@ -5359,17 +5523,17 @@ proof - 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']) + 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 + using set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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: + 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" @@ -5380,68 +5544,68 @@ proof - show "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 + 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 + 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" + 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 + 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: + 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" + 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" + 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' + 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" + 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]) + 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: + have child_not_in_any_children: "\p children. h2 \ get_child_nodes p \\<^sub>r children \ node \ set children" using wellformed h2 adopt_node_removes_child \type_wf h\ \known_ptrs h\ by auto have "node \ set disconnected_nodes_h2" - using disconnected_nodes_h2 h2 adopt_node_node_in_disconnected_nodes assms(1) - \type_wf h\ \known_ptrs h\ by blast - have node_not_in_disconnected_nodes: - "\d. d |\| document_ptr_kinds h3 \ node \ set |h3 \ get_disconnected_nodes d|\<^sub>r" + 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" @@ -5449,26 +5613,26 @@ proof - 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 + 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 + 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) + 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 + using disconnected_nodes_eq2_h2[OF False] \node \ set disconnected_nodes_h2\ + disconnected_nodes_h2 by fastforce qed qed - have "cast node \ ptr" + have "cast node \ ptr" using ancestors node_not_in_ancestors get_ancestors_ptr by fast @@ -5478,7 +5642,7 @@ proof - 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 + 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]) @@ -5502,14 +5666,14 @@ proof - 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) + apply(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h' children_eq2_h3 + insert_before_list_node_in_set)[1] + apply (metis (no_types, lifting) children_eq2_h3 insert_before_list_in_set select_result_I2) by (metis (no_types, lifting) children_eq2_h3 imageI insert_before_list_in_set select_result_I2) ultimately show ?thesis by(auto simp add: acyclic_heap_def) qed - + moreover have "a_all_ptrs_in_heap h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) @@ -5517,49 +5681,57 @@ proof - proof - have "a_all_ptrs_in_heap h3" using \a_all_ptrs_in_heap h2\ - apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2 node_ptr_kinds_eq2_h2 - children_eq_h2)[1] + apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2 node_ptr_kinds_eq2_h2 + children_eq_h2)[1] using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 using node_ptr_kinds_eq2_h2 apply auto[1] - apply (metis \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) + 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\ + 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 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) + 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] - by (metis (no_types, hide_lams) contra_subsetD finite_set_in insert_before_list_in_set - node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' - object_ptr_kinds_M_eq3_h2) + by (metis (no_types, hide_lams) contra_subsetD finite_set_in insert_before_list_in_set + node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' + object_ptr_kinds_M_eq3_h2) then show ?thesis using \a_all_ptrs_in_heap h3\ - 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] + apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def + node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1] using children_eq_h3 children_h' apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD) - by (metis (no_types) \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) + 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" - proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2 - children_eq2_h2 intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2 + children_eq2_h2 intro!: distinct_concat_map_I)[1] fix x assume 1: "x |\| document_ptr_kinds h3" - and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" show "distinct |h3 \ get_disconnected_nodes x|\<^sub>r" - using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3] - disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1 + using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3] + disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1 by (metis (full_types) distinct_remove1 finite_fset fmember.rep_eq set_sorted_list_of_set) - next + next fix x y xa - assume 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and 2: "x |\| document_ptr_kinds h3" and 3: "y |\| document_ptr_kinds h3" @@ -5571,8 +5743,8 @@ proof - case True then have "y \ owner_document" using 4 by simp - show ?thesis - using distinct_concat_map_E(1)[OF 1] + show ?thesis + using distinct_concat_map_E(1)[OF 1] using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3] select_result_I2[OF disconnected_nodes_h2] apply(auto simp add: True disconnected_nodes_eq2_h2[OF \y \ owner_document\])[1] by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal notin_set_remove1) @@ -5581,18 +5753,18 @@ proof - then show ?thesis proof (cases "y = owner_document") case True - then show ?thesis - using distinct_concat_map_E(1)[OF 1] - using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3] select_result_I2[OF disconnected_nodes_h2] - apply(auto simp add: True disconnected_nodes_eq2_h2[OF \x \ owner_document\])[1] - by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal notin_set_remove1) + then show ?thesis + using distinct_concat_map_E(1)[OF 1] + using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3] select_result_I2[OF disconnected_nodes_h2] + apply(auto simp add: True disconnected_nodes_eq2_h2[OF \x \ owner_document\])[1] + by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal notin_set_remove1) next case False - then show ?thesis + then show ?thesis using distinct_concat_map_E(1)[OF 1, simplified, OF 2 3 4] 5 6 - using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 - disjoint_iff_not_equal finite_fset fmember.rep_eq notin_set_remove1 select_result_I2 - set_sorted_list_of_set + using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 + disjoint_iff_not_equal finite_fset fmember.rep_eq notin_set_remove1 select_result_I2 + set_sorted_list_of_set by (metis (no_types, lifting)) qed qed @@ -5606,15 +5778,15 @@ proof - and 5: "x \ set |h3 \ get_disconnected_nodes xb|\<^sub>r" have 6: "set |h3 \ get_child_nodes xa|\<^sub>r \ set |h2 \ get_disconnected_nodes xb|\<^sub>r = {}" using 1 2 4 - by (metis \type_wf h2\ children_eq2_h2 document_ptr_kinds_commutes known_ptrs - local.get_child_nodes_ok local.get_disconnected_nodes_ok - local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr - object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result - wellformed_h2) + by (metis \type_wf h2\ children_eq2_h2 document_ptr_kinds_commutes known_ptrs + local.get_child_nodes_ok local.get_disconnected_nodes_ok + local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr + object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result + wellformed_h2) show False proof (cases "xb = owner_document") case True - then show ?thesis + then show ?thesis using select_result_I2[OF disconnected_nodes_h3,folded select_result_I2[OF disconnected_nodes_h2]] by (metis (no_types, lifting) "3" "5" "6" disjoint_iff_not_equal notin_set_remove1) next @@ -5624,29 +5796,29 @@ proof - qed qed then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3 - disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3 + disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)[1] fix x assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" and - 2: "x |\| object_ptr_kinds h'" + 2: "x |\| object_ptr_kinds h'" have 3: "\p. p |\| object_ptr_kinds h' \ distinct |h3 \ get_child_nodes p|\<^sub>r" using 1 by (auto elim: distinct_concat_map_E) show "distinct |h' \ get_child_nodes x|\<^sub>r" proof(cases "ptr = x") case True show ?thesis - using 3[OF 2] children_h3 children_h' - by(auto simp add: True insert_before_list_distinct - dest: child_not_in_any_children[unfolded children_eq_h2]) + using 3[OF 2] children_h3 children_h' + by(auto simp add: True insert_before_list_distinct + dest: child_not_in_any_children[unfolded children_eq_h2]) next case False - show ?thesis + show ?thesis using children_eq2_h3[OF False] 3[OF 2] by auto qed next fix x y xa - assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) + assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" and 2: "x |\| object_ptr_kinds h'" and 3: "y |\| object_ptr_kinds h'" @@ -5663,23 +5835,23 @@ proof - then show ?thesis using children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6 apply(auto simp add: True children_eq2_h3[OF \ptr \ y\])[1] - by (metis (no_types, hide_lams) "3" "7" \type_wf h3\ children_eq2_h3 disjoint_iff_not_equal - get_child_nodes_ok insert_before_list_in_set known_ptrs local.known_ptrs_known_ptr - object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' - object_ptr_kinds_M_eq3_h2 returns_result_select_result select_result_I2) + by (metis (no_types, hide_lams) "3" "7" \type_wf h3\ children_eq2_h3 disjoint_iff_not_equal + get_child_nodes_ok insert_before_list_in_set known_ptrs local.known_ptrs_known_ptr + object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' + object_ptr_kinds_M_eq3_h2 returns_result_select_result select_result_I2) next case False then show ?thesis proof (cases "ptr = y") case True - then show ?thesis + then show ?thesis using children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6 apply(auto simp add: True children_eq2_h3[OF \ptr \ x\])[1] by (metis (no_types, hide_lams) "2" "4" "7" IntI \known_ptrs h3\ \type_wf h'\ - children_eq_h3 empty_iff insert_before_list_in_set local.get_child_nodes_ok - local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h' - returns_result_select_result select_result_I2) - next + children_eq_h3 empty_iff insert_before_list_in_set local.get_child_nodes_ok + local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h' + returns_result_select_result select_result_I2) + next case False then show ?thesis using children_eq2_h3[OF \ptr \ x\] children_eq2_h3[OF \ptr \ y\] 5 6 7 by auto @@ -5687,7 +5859,7 @@ proof - qed next fix x xa xb - assume 1: " (\x\fset (object_ptr_kinds h'). set |h3 \ get_child_nodes x|\<^sub>r) + assume 1: " (\x\fset (object_ptr_kinds h'). set |h3 \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h' \ get_disconnected_nodes x|\<^sub>r) = {} " and 2: "xa |\| object_ptr_kinds h'" and 3: "x \ set |h' \ get_child_nodes xa|\<^sub>r" @@ -5703,7 +5875,7 @@ proof - then have f1: "h3 \ get_disconnected_nodes xb \\<^sub>r |h' \ get_disconnected_nodes xb|\<^sub>r" by (simp add: disconnected_nodes_eq_h3) have "xa |\| object_ptr_kinds h3" - using "2" object_ptr_kinds_M_eq3_h' by blast + using "2" object_ptr_kinds_M_eq3_h' by blast then show ?thesis using f1 \local.a_distinct_lists h3\ local.distinct_lists_no_parent by fastforce qed @@ -5711,17 +5883,17 @@ proof - proof (cases "ptr = xa") case True show ?thesis - using 6 node_not_in_disconnected_nodes 3 4 5 select_result_I2[OF children_h'] - select_result_I2[OF children_h3] True disconnected_nodes_eq2_h3 - by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M - \a_distinct_lists h3\ \type_wf h'\ disconnected_nodes_eq_h3 - distinct_lists_no_parent document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok - insert_before_list_in_set object_ptr_kinds_M_eq3_h' returns_result_select_result) + using 6 node_not_in_disconnected_nodes 3 4 5 select_result_I2[OF children_h'] + select_result_I2[OF children_h3] True disconnected_nodes_eq2_h3 + by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M + \a_distinct_lists h3\ \type_wf h'\ disconnected_nodes_eq_h3 + distinct_lists_no_parent document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok + insert_before_list_in_set object_ptr_kinds_M_eq3_h' returns_result_select_result) - next + next case False then show ?thesis - using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce + using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce qed qed @@ -5729,13 +5901,15 @@ proof - using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_M_eq2_h2 - object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 - document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 children_eq2_h2)[1] - apply(auto simp add: document_ptr_kinds_eq2_h2[simplified] document_ptr_kinds_eq2_h3[simplified] - object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified] - node_ptr_kinds_eq2_h2[simplified] node_ptr_kinds_eq2_h3[simplified])[1] + object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 + document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 children_eq2_h2)[1] + apply(auto simp add: document_ptr_kinds_eq2_h2[simplified] document_ptr_kinds_eq2_h3[simplified] + object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified] + node_ptr_kinds_eq2_h2[simplified] node_ptr_kinds_eq2_h3[simplified])[1] apply(auto simp add: disconnected_nodes_eq2_h3[symmetric])[1] - by (smt children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set object_ptr_kinds_M_eq3_h' ptr_in_heap select_result_I2) + 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) @@ -5744,9 +5918,10 @@ qed lemma adopt_node_children_remain_distinct: 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'. + 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 + using assms(1) assms(2) assms(3) assms(4) local.adopt_node_preserves_wellformedness + local.heap_is_wellformed_children_distinct by blast @@ -5755,7 +5930,7 @@ lemma insert_node_children_remain_distinct: 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'. + shows "\children'. h' \ get_child_nodes ptr \\<^sub>r children' \ distinct children'" proof - fix children' @@ -5763,7 +5938,8 @@ proof - 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) + 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 @@ -5776,27 +5952,27 @@ qed lemma insert_before_children_remain_distinct: 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'. + 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 + "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) + 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" @@ -5815,7 +5991,8 @@ proof - 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) + by (meson assms(1) assms(2) assms(3) assms(4) insert_before_heap_is_wellformed_preserved(1) + local.heap_is_wellformed_children_distinct) qed @@ -5831,26 +6008,26 @@ proof - 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 + "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) + 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) + 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] @@ -5858,18 +6035,18 @@ proof - 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 + 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 + 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]) + 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 + 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 ) @@ -5885,12 +6062,13 @@ proof - 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]) + 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 + 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" + 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 @@ -5901,17 +6079,17 @@ proof - 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']) + 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 + using set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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: + 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" @@ -5922,61 +6100,62 @@ proof - 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" + 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 + 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" + 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 + 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: + 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" + 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" + 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' + 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" + 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]) + 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: + 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'" @@ -6003,8 +6182,9 @@ proof - } \\<^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 - + 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 { @@ -6020,7 +6200,8 @@ proof - 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) + 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 @@ -6034,51 +6215,51 @@ proof - 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 + 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 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) + 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) + apply (smt assms(5) assms(8) is_OK_returns_result_I returns_result_eq) + by(auto) qed end -locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs - + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs + - assumes insert_before_preserves_type_wf: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' +locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs + + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs + + assumes insert_before_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' \ type_wf h'" - assumes insert_before_preserves_known_ptrs: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' + assumes insert_before_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' \ known_ptrs h'" assumes insert_before_heap_is_wellformed_preserved: "type_wf h \ known_ptrs h \ heap_is_wellformed h \ h \ insert_before ptr child ref \\<^sub>h h' \ heap_is_wellformed h'" -interpretation i_insert_before_wf2?: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs - get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_ancestors get_ancestors_locs - adopt_node adopt_node_locs set_disconnected_nodes - set_disconnected_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs get_owner_document insert_before - insert_before_locs append_child type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel remove_child - remove_child_locs get_root_node get_root_node_locs +interpretation i_insert_before_wf2?: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs + get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_ancestors get_ancestors_locs + adopt_node adopt_node_locs set_disconnected_nodes + set_disconnected_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs get_owner_document insert_before + insert_before_locs append_child type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel remove_child + remove_child_locs get_root_node get_root_node_locs by(simp add: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -lemma insert_before_wf2_is_l_insert_before_wf2 [instances]: +lemma insert_before_wf2_is_l_insert_before_wf2 [instances]: "l_insert_before_wf2 type_wf known_ptr known_ptrs insert_before heap_is_wellformed" apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1] using insert_before_heap_is_wellformed_preserved apply(fast, fast, fast) @@ -6101,9 +6282,9 @@ proof - have "known_ptr (cast node_ptr)" using assms(2) assms(4) local.known_ptrs_known_ptr node_ptr_kinds_commutes by blast then show ?thesis - using assms - apply(auto simp add: a_next_sibling_def intro!: bind_is_OK_pure_I split: option.splits list.splits)[1] - using get_child_nodes_ok local.get_parent_parent_in_heap local.known_ptrs_known_ptr by blast + using assms + apply(auto simp add: a_next_sibling_def intro!: bind_is_OK_pure_I split: option.splits list.splits)[1] + using get_child_nodes_ok local.get_parent_parent_in_heap local.known_ptrs_known_ptr by blast qed lemma remove_child_ok: @@ -6128,45 +6309,49 @@ proof - then show False using assms returns_result_eq by fastforce - qed + 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" + 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)[1] - apply (meson invoke_empty is_OK_returns_result_I) - apply (meson invoke_empty is_OK_returns_result_I) + 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) + 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) + 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) + 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 + using \ptr |\| object_ptr_kinds h\ by blast - have "type_wf h2" + 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]) + 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) @@ -6174,25 +6359,31 @@ proof - 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 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) + 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) + by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs + ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) ultimately show ?thesis using assms(4) apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def)[1] apply(split invoke_splits)+ apply(auto elim!: bind_returns_result_E2 split: option.splits)[1] - apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits)[1] + apply(auto simp add: get_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: option.splits)[1] using assms(5) apply auto[1] - using \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \ptr |\| object_ptr_kinds h\ \type_wf h2\ local.set_child_nodes_document1_ok apply blast - using \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ \ptr |\| object_ptr_kinds h\ \type_wf h2\ is_element_ptr_kind_cast local.set_child_nodes_document2_ok apply blast + using \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ + \ptr |\| object_ptr_kinds h\ \type_wf h2\ local.set_child_nodes_document1_ok apply blast + using \is_document_ptr_kind ptr\ \known_ptr ptr\ \object_ptr_kinds h = object_ptr_kinds h2\ + \ptr |\| object_ptr_kinds h\ \type_wf h2\ is_element_ptr_kind_cast local.set_child_nodes_document2_ok + apply blast using \\ is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr\ apply blast by (metis False is_element_ptr_implies_kind option.case_eq_if) qed @@ -6204,13 +6395,16 @@ proof - 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] + simp add: is_OK_returns_heap_I[OF h2] is_OK_returns_heap_I[OF h'] + is_OK_returns_result_I[OF assms(4)] is_OK_returns_result_I[OF owner_document] + is_OK_returns_result_I[OF disconnected_nodes_h] intro!: bind_is_OK_pure_I[OF get_owner_document_pure] bind_is_OK_pure_I[OF get_child_nodes_pure] bind_is_OK_pure_I[OF get_disconnected_nodes_pure] bind_is_OK_I[rotated, OF h2] - dest!: returns_result_eq[OF assms(4)] returns_result_eq[OF owner_document] returns_result_eq[OF disconnected_nodes_h] -)[1] + dest!: returns_result_eq[OF assms(4)] returns_result_eq[OF owner_document] + returns_result_eq[OF disconnected_nodes_h] + )[1] using h2 returns_result_select_result by force qed @@ -6221,15 +6415,16 @@ lemma adopt_node_ok: 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) + 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) + 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 @@ -6239,35 +6434,37 @@ proof - 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" + 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]) + 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 + 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) + by(auto split: option.splits) have "type_wf h2" using h2 remove_child_preserves_type_wf assms - by(auto split: option.splits) + by(auto split: option.splits) have "known_ptrs h2" using h2 remove_child_preserves_known_ptrs assms - by(auto split: option.splits) + 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]) + 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" @@ -6301,12 +6498,12 @@ proof - 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 + 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" + 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) @@ -6318,7 +6515,7 @@ proof - 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: + 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) @@ -6329,7 +6526,7 @@ proof - 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 + 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 @@ -6388,37 +6585,47 @@ lemma insert_node_ok: 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) +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 + 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) + 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) + 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) + 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) + 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) + 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 @@ -6436,7 +6643,7 @@ 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 + 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 @@ -6452,19 +6659,21 @@ proof - 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 + using assms(1) assms(2) assms(3) local.get_owner_document_owner_document_in_heap owner_document + by blast - obtain h2 where + 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) + 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]) + 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 + 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) @@ -6477,23 +6686,27 @@ proof - 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) - + 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) + 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 + 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]) + 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 + using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) have "parent |\| object_ptr_kinds h3" @@ -6503,23 +6716,26 @@ proof - 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) + 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' + 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_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!: returns_result_eq[OF owner_document] returns_result_eq[OF disconnected_nodes_h2] + returns_heap_eq[OF h2] returns_heap_eq[OF h3] dest!: sym[of node ref] )[1] using returns_result_eq by fastforce @@ -6527,7 +6743,11 @@ 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 + 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] @@ -6549,7 +6769,8 @@ lemma append_child_heap_is_wellformed_preserved: 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) + 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" @@ -6568,21 +6789,21 @@ proof - h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \\<^sub>h h3" and h': "h3 \ a_insert_node ptr node None \\<^sub>h h'" using assms(5) - by(auto simp add: append_child_def insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - split: if_splits option.splits) + by(auto simp add: append_child_def insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) have "\parent. |h \ get_parent node|\<^sub>r = Some parent \ parent \ ptr" using assms(1) assms(4) assms(6) - by (metis (no_types, lifting) assms(2) assms(3) h2 is_OK_returns_heap_I is_OK_returns_result_E - local.adopt_node_child_in_heap local.get_parent_child_dual local.get_parent_ok - select_result_I2) + by (metis (no_types, lifting) assms(2) assms(3) h2 is_OK_returns_heap_I is_OK_returns_result_E + local.adopt_node_child_in_heap local.get_parent_child_dual local.get_parent_ok + select_result_I2) have "h2 \ get_child_nodes ptr \\<^sub>r xs" using get_child_nodes_reads adopt_node_writes h2 assms(4) apply(rule reads_writes_separate_forwards) @@ -6609,14 +6830,14 @@ proof - 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 + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) show "h' \ get_child_nodes ptr \\<^sub>r xs@[node]" - using h' - apply(auto simp add: a_insert_node_def - dest!: bind_returns_heap_E3[rotated, OF \h3 \ get_child_nodes ptr \\<^sub>r xs\ - get_child_nodes_pure, rotated])[1] + using h' + apply(auto simp add: a_insert_node_def + dest!: bind_returns_heap_E3[rotated, OF \h3 \ get_child_nodes ptr \\<^sub>r xs\ + get_child_nodes_pure, rotated])[1] using \type_wf h3\ set_child_nodes_get_child_nodes \known_ptr ptr\ by metis qed @@ -6630,10 +6851,10 @@ lemma append_child_for_all_on_children: shows "h' \ get_child_nodes ptr \\<^sub>r xs@nodes" using assms apply(induct nodes arbitrary: h xs) - apply(simp) + apply(simp) proof(auto elim!: bind_returns_heap_E)[1]fix a nodes h xs h'a - assume 0: "(\h xs. heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r xs \ h \ forall_M (append_child ptr) nodes \\<^sub>h h' + assume 0: "(\h xs. heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r xs \ h \ forall_M (append_child ptr) nodes \\<^sub>h h' \ set nodes \ set xs = {} \ h' \ get_child_nodes ptr \\<^sub>r xs @ nodes)" and 1: "heap_is_wellformed h" and 2: "type_wf h" @@ -6651,8 +6872,8 @@ proof(auto elim!: bind_returns_heap_E)[1]fix a nodes h xs h'a using "1" "2" "3" "4" "8" by blast moreover have "heap_is_wellformed h'a" and "type_wf h'a" and "known_ptrs h'a" - using insert_before_heap_is_wellformed_preserved insert_before_preserves_known_ptrs - insert_before_preserves_type_wf 1 2 3 6 append_child_def + using insert_before_heap_is_wellformed_preserved insert_before_preserves_known_ptrs + insert_before_preserves_type_wf 1 2 3 6 append_child_def by metis+ moreover have "set nodes \ set (xs @ [a]) = {}" using 9 10 @@ -6674,28 +6895,29 @@ lemma append_child_for_all_on_no_children: 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' + 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' + 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 - set_disconnected_nodes set_disconnected_nodes_locs - adopt_node adopt_node_locs known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs set_child_nodes - set_child_nodes_locs remove get_ancestors get_ancestors_locs - insert_before insert_before_locs append_child heap_is_wellformed - parent_child_rel +interpretation i_append_child_wf?: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent + get_parent_locs remove_child remove_child_locs + get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs + adopt_node adopt_node_locs known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs set_child_nodes + set_child_nodes_locs remove get_ancestors get_ancestors_locs + insert_before insert_before_locs append_child heap_is_wellformed + parent_child_rel by(auto simp add: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) -lemma append_child_wf_is_l_append_child_wf [instances]: "l_append_child_wf type_wf known_ptr known_ptrs append_child heap_is_wellformed" +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+ @@ -6703,38 +6925,38 @@ lemma append_child_wf_is_l_append_child_wf [instances]: "l_append_child_wf type_ subsection \create\_element\ locale l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel + + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel + l_new_element_get_disconnected_nodes get_disconnected_nodes get_disconnected_nodes_locs + l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs - get_disconnected_nodes get_disconnected_nodes_locs + - l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr + + get_disconnected_nodes get_disconnected_nodes_locs + + l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr + l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr - get_child_nodes get_child_nodes_locs + - l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs - get_child_nodes get_child_nodes_locs + + get_child_nodes get_child_nodes_locs + + l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs + get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs + - l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + + l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + l_new_element type_wf + l_known_ptrs known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and known_ptrs :: "(_) heap \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" + and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" begin lemma create_element_preserves_wellformedness: assumes "heap_is_wellformed h" @@ -6749,19 +6971,20 @@ proof - h3: "h2 \ set_tag_name 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'" - using assms(2) + using assms(2) by(auto simp add: create_element_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + 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) + 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 - using new_element_ptr_not_in_heap by blast + using new_element_ptr_not_in_heap by blast then have "cast new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r" by simp then have "cast new_element_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r" @@ -6783,18 +7006,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", OF set_tag_name_writes h3]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_tag_name_writes h3]) using set_tag_name_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -6804,7 +7028,8 @@ proof - 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 + 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 @@ -6818,47 +7043,47 @@ proof - have "document_ptr |\| document_ptr_kinds h" - using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_element_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_element_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h2 get_child_nodes_new_element[rotated, OF new_element_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: "\ptr'. ptr' \ cast new_element_ptr + then have children_eq2_h: "\ptr'. ptr' \ cast new_element_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes (cast new_element_ptr) \\<^sub>r []" - using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr] - new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes + using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr] + new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" using get_disconnected_nodes_reads h2 get_disconnected_nodes_new_element[OF new_element_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have disconnected_nodes_eq2_h: + then have disconnected_nodes_eq2_h: "\doc_ptr. |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - have children_eq_h2: + 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_tag_name_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_tag_name_get_child_nodes) then have children_eq2_h2: "\ptr'. |h2 \ get_child_nodes ptr'|\<^sub>r = |h3 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. 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_tag_name_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_tag_name_get_disconnected_nodes) - then have disconnected_nodes_eq2_h2: + then have disconnected_nodes_eq2_h2: "\doc_ptr. |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force @@ -6870,40 +7095,40 @@ proof - by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) - have children_eq_h3: + have children_eq_h3: "\ptr' children. h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_child_nodes) then have children_eq2_h3: "\ptr'. |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h3: - "\doc_ptr disc_nodes. document_ptr \ doc_ptr - \ h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: - "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: + "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h2 disc_nodes_h3 by auto then have disc_nodes_document_ptr_h: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h by auto then have "cast new_element_ptr \ set disc_nodes_h3" - using \heap_is_wellformed h\ - using \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 + 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 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\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h2" proof(auto simp add: parent_child_rel_def)[1] @@ -6917,12 +7142,12 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h2 \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.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>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) + by (metis ObjectMonad.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>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) next fix a x assume 0: "a |\| object_ptr_kinds h2" - and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq_h \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 []\ by(auto) @@ -6931,9 +7156,9 @@ proof - assume 0: "a |\| object_ptr_kinds h2" and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) - \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_h empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) + \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_h empty_iff empty_set image_eqI select_result_I2) qed also have "\ = parent_child_rel h3" by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2) @@ -6946,69 +7171,79 @@ 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] - 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) + 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 (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) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - by (smt \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)) + 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 set_disconnected_nodes_get_disconnected_nodes + local.a_all_ptrs_in_heap_def local.get_child_nodes_ptr_in_heap node_ptr_kinds_commutes + object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1)) have "\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\ - heap_is_wellformed_children_in_heap - by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp - fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) + 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\ + heap_is_wellformed_children_in_heap + by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp + fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) then have "\p. p |\| object_ptr_kinds h2 \ cast new_element_ptr \ set |h2 \ get_child_nodes p|\<^sub>r" using children_eq2_h apply(auto simp add: object_ptr_kinds_eq_h)[1] using \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 []\ apply auto[1] - by (metis ObjectMonad.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>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\) + by (metis ObjectMonad.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>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\) then have "\p. p |\| object_ptr_kinds h3 \ cast new_element_ptr \ set |h3 \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h2 children_eq2_h2 by auto - then have new_element_ptr_not_in_any_children: + then have new_element_ptr_not_in_any_children: "\p. p |\| object_ptr_kinds h' \ cast new_element_ptr \ set |h' \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h3 children_eq2_h3 by auto have "a_distinct_lists h" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h2" using \h2 \ get_child_nodes (cast new_element_ptr) \\<^sub>r []\ - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) apply(case_tac "x=cast new_element_ptr") apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok + apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result) apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h + by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result) - + then have "a_distinct_lists h3" - by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 - children_eq2_h2 object_ptr_kinds_eq_h2) + by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + children_eq2_h2 object_ptr_kinds_eq_h2) then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 - object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 - intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 + object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 + intro!: distinct_concat_map_I)[1] fix x - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h' set_disconnected_nodes_get_disconnected_nodes - by (metis (no_types, lifting) \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 disc_nodes_h3\ - \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) - distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) \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 disc_nodes_h3\ + \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) + distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq + returns_result_select_result) next fix x y xa - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" and "y |\| document_ptr_kinds h3" @@ -7020,37 +7255,39 @@ proof - ultimately show "False" apply(-) apply(cases "x = document_ptr") - 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) + 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) + assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h3). set |h3 \ get_disconnected_nodes x|\<^sub>r) = {}" and 3: "xa |\| object_ptr_kinds h3" and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" and 5: "xb |\| document_ptr_kinds h3" and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" - show "False" + show "False" using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3 apply - apply(cases "xb = document_ptr") - apply (metis (no_types, hide_lams) "3" "4" "6" - \\p. p |\| object_ptr_kinds h3 - \ 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 |h3 \ get_child_nodes p|\<^sub>r\ - \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' - select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) - by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 - distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) + apply (metis (no_types, hide_lams) "3" "4" "6" + \\p. p |\| object_ptr_kinds h3 + \ 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 |h3 \ get_child_nodes p|\<^sub>r\ + \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' + select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) + by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 + distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) qed have "a_owner_document_valid h" @@ -7064,13 +7301,17 @@ proof - apply(auto simp add: document_ptr_kinds_eq_h2)[1] apply(auto simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )[1] apply(auto simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )[1] - apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] - disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 + apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] + disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] - apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) - local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) + apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) apply(simp add: object_ptr_kinds_eq_h) - by(metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \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) + by (smt ObjectMonad.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>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 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 + disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h' list.set_intros(2) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) show "heap_is_wellformed h'" using \a_acyclic_heap h'\ \a_all_ptrs_in_heap h'\ \a_distinct_lists h'\ \a_owner_document_valid h'\ @@ -7078,11 +7319,11 @@ proof - qed end -interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf - get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel - set_tag_name set_tag_name_locs - set_disconnected_nodes set_disconnected_nodes_locs create_element +interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf + get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + set_tag_name set_tag_name_locs + set_disconnected_nodes set_disconnected_nodes_locs create_element using instances by(auto simp add: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] @@ -7092,46 +7333,46 @@ subsection \create\_character\_data\ locale l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + l_new_character_data_get_disconnected_nodes - get_disconnected_nodes get_disconnected_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_set_val_get_disconnected_nodes - type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs set_val set_val_locs type_wf create_character_data known_ptr + 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 + type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_val_get_child_nodes - type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs + type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes_get_child_nodes - set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes - type_wf set_disconnected_nodes set_disconnected_nodes_locs + type_wf set_disconnected_nodes set_disconnected_nodes_locs + l_set_disconnected_nodes_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + l_new_character_data - type_wf + type_wf + l_known_ptrs - known_ptr known_ptrs + known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: - "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_character_data :: - "(_) document_ptr \ char list \ ((_) heap, exception, (_) character_data_ptr) prog" - and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: + "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_character_data :: + "(_) document_ptr \ char list \ ((_) heap, exception, (_) character_data_ptr) prog" + and known_ptrs :: "(_) heap \ bool" begin lemma create_character_data_preserves_wellformedness: @@ -7147,21 +7388,22 @@ proof - 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'" - using assms(2) - by(auto simp add: create_character_data_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + using assms(2) + by(auto simp add: create_character_data_def + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) then have "h \ 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)[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) + 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" using new_character_data_ptr CharacterDataMonad.ptr_kinds_ptr_kinds_M h2 - using new_character_data_ptr_not_in_heap by blast + using new_character_data_ptr_not_in_heap by blast then have "cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r" by simp then have "cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r" @@ -7169,14 +7411,14 @@ proof - - have object_ptr_kinds_eq_h: + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" using new_character_data_new_ptr h2 new_character_data_ptr by blast - then have node_ptr_kinds_eq_h: + then have node_ptr_kinds_eq_h: "node_ptr_kinds h2 = node_ptr_kinds h |\| {|cast new_character_data_ptr|}" apply(simp add: node_ptr_kinds_def) by force - then have character_data_ptr_kinds_eq_h: + then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\| {|new_character_data_ptr|}" apply(simp add: character_data_ptr_kinds_def) by force @@ -7188,19 +7430,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_val_writes h3]) + 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) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -7211,27 +7453,28 @@ proof - have "document_ptr |\| document_ptr_kinds h" - using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" - using get_child_nodes_reads h2 get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2] + using get_child_nodes_reads h2 + get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: - "\ptr'. ptr' \ cast new_character_data_ptr + then have children_eq2_h: + "\ptr'. ptr' \ cast new_character_data_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have object_ptr_kinds_eq_h: + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" using new_character_data_new_ptr h2 new_character_data_ptr by blast - then have node_ptr_kinds_eq_h: + then have node_ptr_kinds_eq_h: "node_ptr_kinds h2 = node_ptr_kinds h |\| {|cast new_character_data_ptr|}" apply(simp add: node_ptr_kinds_def) by force - then have character_data_ptr_kinds_eq_h: + then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\| {|new_character_data_ptr|}" apply(simp add: character_data_ptr_kinds_def) by force @@ -7243,19 +7486,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_val_writes h3]) + 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) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -7266,50 +7509,50 @@ proof - have "document_ptr |\| document_ptr_kinds h" - using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h2 get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: "\ptr'. ptr' \ cast new_character_data_ptr + then have children_eq2_h: "\ptr'. ptr' \ cast new_character_data_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []" - using new_character_data_ptr h2 new_character_data_ptr_in_heap[OF h2 new_character_data_ptr] - new_character_data_is_character_data_ptr[OF new_character_data_ptr] - new_character_data_no_child_nodes + using new_character_data_ptr h2 new_character_data_ptr_in_heap[OF h2 new_character_data_ptr] + new_character_data_is_character_data_ptr[OF new_character_data_ptr] + new_character_data_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" - using get_disconnected_nodes_reads h2 - get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2] + using get_disconnected_nodes_reads h2 + get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have disconnected_nodes_eq2_h: + then have disconnected_nodes_eq2_h: "\doc_ptr. |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - have children_eq_h2: + 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_val_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_val_get_child_nodes) - then have children_eq2_h2: + 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 disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. 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_val_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_val_get_disconnected_nodes) - then have disconnected_nodes_eq2_h2: + then have disconnected_nodes_eq2_h2: "\doc_ptr. |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force @@ -7317,42 +7560,42 @@ proof - using \type_wf h\ new_character_data_types_preserved h2 by blast then have "type_wf h3" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_val_writes h3] - using set_val_types_preserved + using set_val_types_preserved by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) - have children_eq_h3: + have children_eq_h3: "\ptr' children. h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_child_nodes) - then have children_eq2_h3: + then have children_eq2_h3: " \ptr'. |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h3: "\doc_ptr disc_nodes. document_ptr \ doc_ptr - \ h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h2 disc_nodes_h3 by auto then have disc_nodes_document_ptr_h: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h by auto then have "cast new_character_data_ptr \ set disc_nodes_h3" using \heap_is_wellformed h\ using \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def heap_is_wellformed_def + a_all_ptrs_in_heap_def heap_is_wellformed_def using NodeMonad.ptr_kinds_ptr_kinds_M local.heap_is_wellformed_disc_nodes_in_heap by blast have "acyclic (parent_child_rel h)" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h2" proof(auto simp add: parent_child_rel_def)[1] @@ -7366,12 +7609,12 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h2 \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M - \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2_h) + by (metis ObjectMonad.ptr_kinds_ptr_kinds_M + \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2_h) next fix a x assume 0: "a |\| object_ptr_kinds h2" - and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq_h \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ by(auto) @@ -7380,8 +7623,8 @@ proof - assume 0: "a |\| object_ptr_kinds h2" and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ - children_eq2_h empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ + children_eq2_h empty_iff empty_set image_eqI select_result_I2) qed also have "\ = parent_child_rel h3" by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2) @@ -7394,30 +7637,30 @@ 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_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, 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) + 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, 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 (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) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - by (smt character_data_ptr_kinds_commutes children_eq2_h3 disc_nodes_document_ptr_h2 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 - finite_set_in h' h2 local.a_all_ptrs_in_heap_def - local.set_disconnected_nodes_get_disconnected_nodes new_character_data_ptr - new_character_data_ptr_in_heap node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 - object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1)) + 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 - by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp - fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) + heap_is_wellformed_children_in_heap + by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp + fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) then have "\p. p |\| object_ptr_kinds h2 \ cast new_character_data_ptr \ set |h2 \ get_child_nodes p|\<^sub>r" using children_eq2_h apply(auto simp add: object_ptr_kinds_eq_h)[1] @@ -7425,44 +7668,44 @@ proof - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\) then have "\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h2 children_eq2_h2 by auto - then have new_character_data_ptr_not_in_any_children: + then have new_character_data_ptr_not_in_any_children: "\p. p |\| object_ptr_kinds h' \ cast new_character_data_ptr \ set |h' \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h3 children_eq2_h3 by auto have "a_distinct_lists h" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h2" using \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) apply(case_tac "x=cast new_character_data_ptr") apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok - local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr + apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok + local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result) apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h + by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result) then have "a_distinct_lists h3" - by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 - children_eq2_h2 object_ptr_kinds_eq_h2)[1] + by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + children_eq2_h2 object_ptr_kinds_eq_h2)[1] then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 - object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 + object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1] fix x - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h' set_disconnected_nodes_get_disconnected_nodes - by (metis (no_types, lifting) \cast new_character_data_ptr \ set disc_nodes_h3\ - \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) - distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) \cast new_character_data_ptr \ set disc_nodes_h3\ + \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) + distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq + returns_result_select_result) next fix x y xa assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) @@ -7475,16 +7718,17 @@ 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" - 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) + 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) + assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h3). set |h3 \ get_disconnected_nodes x|\<^sub>r) = {}" and 3: "xa |\| object_ptr_kinds h3" and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" @@ -7494,11 +7738,11 @@ proof - using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3 apply(cases "xb = document_ptr") apply (metis (no_types, hide_lams) "3" "4" "6" - \\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r\ - \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' - select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) - by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 - distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) + \\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r\ + \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' + select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) + by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 + distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) qed have "a_owner_document_valid h" @@ -7512,20 +7756,19 @@ proof - apply(simp add: document_ptr_kinds_eq_h2) apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 ) apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h ) - apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] disconnected_nodes_eq2_h - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] - apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) - local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) + apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] disconnected_nodes_eq2_h + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] + apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) apply(simp add: object_ptr_kinds_eq_h) - by (metis (mono_tags, lifting) \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) + by (smt 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 finite_set_in h' list.set_intros(2) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) have "known_ptr (cast new_character_data_ptr)" - using \h \ create_character_data document_ptr text \\<^sub>r new_character_data_ptr\ local.create_character_data_known_ptr by blast + 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 @@ -7543,10 +7786,10 @@ proof - qed end -interpretation i_create_character_data_wf?: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf - get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes - set_disconnected_nodes_locs create_character_data known_ptrs +interpretation i_create_character_data_wf?: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf + get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes + set_disconnected_nodes_locs create_character_data known_ptrs using instances by (auto simp add: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] @@ -7556,32 +7799,32 @@ subsection \create\_document\ locale l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + l_new_document_get_disconnected_nodes - get_disconnected_nodes get_disconnected_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - create_document + create_document + l_new_document_get_child_nodes - type_wf known_ptr get_child_nodes get_child_nodes_locs - + l_new_document - type_wf + type_wf known_ptr get_child_nodes get_child_nodes_locs + + l_new_document + type_wf + l_known_ptrs - known_ptr known_ptrs + known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_document :: "((_) heap, exception, (_) document_ptr) prog" - and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_document :: "((_) heap, exception, (_) document_ptr) prog" + and known_ptrs :: "(_) heap \ bool" begin lemma create_document_preserves_wellformedness: @@ -7594,7 +7837,7 @@ proof - obtain new_document_ptr where new_document_ptr: "h \ new_document \\<^sub>r new_document_ptr" and h': "h \ new_document \\<^sub>h h'" - using assms(2) + using assms(2) apply(simp add: create_document_def) using new_document_ok by blast @@ -7626,30 +7869,30 @@ proof - by (metis (no_types, lifting) document_ptr_kinds_commutes document_ptr_kinds_def finsertI1 fset.map_comp) - have children_eq: - "\(ptr'::(_) object_ptr) children. ptr' \ cast new_document_ptr + have children_eq: + "\(ptr'::(_) object_ptr) children. ptr' \ cast new_document_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h' get_child_nodes_new_document[rotated, OF new_document_ptr h'] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2: "\ptr'. ptr' \ cast new_document_ptr + then have children_eq2: "\ptr'. ptr' \ cast new_document_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []" - using new_document_ptr h' new_document_ptr_in_heap[OF h' new_document_ptr] - new_document_is_document_ptr[OF new_document_ptr] new_document_no_child_nodes + using new_document_ptr h' new_document_ptr_in_heap[OF h' new_document_ptr] + new_document_is_document_ptr[OF new_document_ptr] new_document_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. doc_ptr \ new_document_ptr + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. doc_ptr \ new_document_ptr \ h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h' \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" using get_disconnected_nodes_reads h' get_disconnected_nodes_new_document_different_pointers new_document_ptr - apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] - by (metis(full_types) \\thesis. (\new_document_ptr. - \h \ new_document \\<^sub>r new_document_ptr; h \ new_document \\<^sub>h h'\ \ thesis) \ thesis\ - local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+ - then have disconnected_nodes_eq2_h: "\doc_ptr. doc_ptr \ new_document_ptr + apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] + by (metis(full_types) \\thesis. (\new_document_ptr. + \h \ new_document \\<^sub>r new_document_ptr; h \ new_document \\<^sub>h h'\ \ thesis) \ thesis\ + local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+ + then have disconnected_nodes_eq2_h: "\doc_ptr. doc_ptr \ new_document_ptr \ |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force have "h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" @@ -7659,7 +7902,7 @@ proof - using \type_wf h\ new_document_types_preserved h' by blast have "acyclic (parent_child_rel h)" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h'" proof(auto simp add: parent_child_rel_def)[1] @@ -7673,51 +7916,55 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h' \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M - \cast new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2) + by (metis ObjectMonad.ptr_kinds_ptr_kinds_M + \cast new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2) next fix a x assume 0: "a |\| object_ptr_kinds h'" - and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ by(auto) - next + next fix a x assume 0: "a |\| object_ptr_kinds h'" and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ - children_eq2 empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ + children_eq2 empty_iff empty_set image_eqI select_result_I2) qed finally have "a_acyclic_heap h'" by (simp add: acyclic_heap_def) have "a_all_ptrs_in_heap h" using \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] - 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) + 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\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h'" - using \h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []\ - \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ + using \h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []\ + \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ - apply(auto simp add: children_eq2[symmetric] a_distinct_lists_def insort_split object_ptr_kinds_eq - document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] + apply(auto simp add: children_eq2[symmetric] a_distinct_lists_def insort_split object_ptr_kinds_eq + document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) apply(auto simp add: dest: distinct_concat_map_E)[1] @@ -7725,9 +7972,9 @@ proof - using \new_document_ptr |\| document_ptr_kinds h\ apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1] using disconnected_nodes_eq_h - apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.get_disconnected_nodes_ok - local.heap_is_wellformed_disconnected_nodes_distinct - returns_result_select_result) + apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.get_disconnected_nodes_ok + local.heap_is_wellformed_disconnected_nodes_distinct + returns_result_select_result) proof - fix x :: "(_) document_ptr" and y :: "(_) document_ptr" and xa :: "(_) node_ptr" assume a1: "x \ y" @@ -7735,7 +7982,7 @@ proof - assume a3: "x \ new_document_ptr" assume a4: "y |\| document_ptr_kinds h" assume a5: "y \ new_document_ptr" - assume a6: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + assume a6: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h)))))" assume a7: "xa \ set |h' \ get_disconnected_nodes x|\<^sub>r" assume a8: "xa \ set |h' \ get_disconnected_nodes y|\<^sub>r" @@ -7753,11 +8000,11 @@ proof - fix x xa xb assume 0: "h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" and 1: "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 []" - and 2: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) + and 2: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))))" - and 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + and 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h)))))" - and 4: "(\x\fset (object_ptr_kinds h). set |h \ get_child_nodes x|\<^sub>r) + and 4: "(\x\fset (object_ptr_kinds h). set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). set |h \ get_disconnected_nodes x|\<^sub>r) = {}" and 5: "x \ set |h \ get_child_nodes xa|\<^sub>r" and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" @@ -7767,28 +8014,29 @@ proof - and 10: "xb \ new_document_ptr" then show "False" - by (metis \local.a_distinct_lists h\ assms(3) disconnected_nodes_eq2_h - local.distinct_lists_no_parent local.get_disconnected_nodes_ok - returns_result_select_result) + by (metis \local.a_distinct_lists h\ assms(3) disconnected_nodes_eq2_h + local.distinct_lists_no_parent local.get_disconnected_nodes_ok + returns_result_select_result) qed have "a_owner_document_valid h" using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" apply(auto simp add: a_owner_document_valid_def)[1] - by (metis \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\ - children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in funion_iff node_ptr_kinds_eq object_ptr_kinds_eq) + 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\ + 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) qed end -interpretation i_create_document_wf?: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel - set_val set_val_locs set_disconnected_nodes - set_disconnected_nodes_locs create_document known_ptrs +interpretation i_create_document_wf?: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + set_val set_val_locs set_disconnected_nodes + set_disconnected_nodes_locs create_document known_ptrs using instances by (auto simp add: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] diff --git a/Core_DOM/Core_DOM/standard/classes/ElementClass.thy b/Core_DOM/Core_DOM/standard/classes/ElementClass.thy index e906ae2..9647cf3 100644 --- a/Core_DOM/Core_DOM/standard/classes/ElementClass.thy +++ b/Core_DOM/Core_DOM/standard/classes/ElementClass.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -34,9 +34,9 @@ theory ElementClass "NodeClass" "ShadowRootPointer" begin -text\The type @{type "DOMString"} is a type synonym for @{type "string"}, define +text\The type @{type "DOMString"} is a type synonym for @{type "string"}, define in \autoref{sec:Core_DOM_Basic_Datatypes}.\ -type_synonym attr_key = DOMString +type_synonym attr_key = DOMString type_synonym attr_value = DOMString type_synonym attrs = "(attr_key, attr_value) fmap" type_synonym tag_name = DOMString @@ -46,36 +46,45 @@ record ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr) RElement child_nodes :: "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr list" attrs :: attrs shadow_root_opt :: "'shadow_root_ptr shadow_root_ptr option" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element - = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_scheme" -register_default_tvars + = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) +RElement_scheme" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node - = "(('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Node" -register_default_tvars + = "(('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext ++ 'Node) Node" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object - = "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Object" -register_default_tvars + = "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) +RElement_ext + 'Node) Object" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object" type_synonym - ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) heap - = "('document_ptr document_ptr + 'shadow_root_ptr shadow_root_ptr + 'object_ptr, 'element_ptr element_ptr + 'character_data_ptr character_data_ptr + 'node_ptr, 'Object, - ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) heap" + ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, + 'Object, 'Node, 'Element) heap + = "('document_ptr document_ptr + 'shadow_root_ptr shadow_root_ptr + 'object_ptr, +'element_ptr element_ptr + 'character_data_ptr character_data_ptr + 'node_ptr, 'Object, +('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" + "('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 - "element_ptr_kinds heap = the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| (ffilter is_element_ptr_kind (node_ptr_kinds heap)))" + "element_ptr_kinds heap = +the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| (ffilter is_element_ptr_kind (node_ptr_kinds heap)))" -lemma element_ptr_kinds_simp [simp]: - "element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = {|element_ptr|} |\| element_ptr_kinds h" +lemma element_ptr_kinds_simp [simp]: + "element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = +{|element_ptr|} |\| element_ptr_kinds h" apply(auto simp add: element_ptr_kinds_def)[1] by force @@ -85,7 +94,8 @@ definition element_ptrs :: "(_) heap \ (_) element_ptr fset" definition 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 :: "(_) Node \ (_) Element option" where - "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 node = (case RNode.more node of Inl element \ Some (RNode.extend (RNode.truncate node) element) | _ \ None)" + "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 node = +(case RNode.more node of Inl element \ Some (RNode.extend (RNode.truncate node) element) | _ \ None)" adhoc_overloading cast 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 abbreviation cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) Object \ (_) Element option" @@ -116,15 +126,15 @@ abbreviation is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr \ cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr \ None" adhoc_overloading is_element_kind is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t -lemma element_ptr_kinds_commutes [simp]: +lemma element_ptr_kinds_commutes [simp]: "cast element_ptr |\| node_ptr_kinds h \ element_ptr |\| element_ptr_kinds h" apply(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)[1] - by (metis (no_types, lifting) element_ptr_casts_commute2 ffmember_filter fimage_eqI - fset.map_comp is_element_ptr_kind_none node_ptr_casts_commute3 + by (metis (no_types, lifting) element_ptr_casts_commute2 ffmember_filter fimage_eqI + fset.map_comp is_element_ptr_kind_none node_ptr_casts_commute3 node_ptr_kinds_commutes node_ptr_kinds_def option.sel option.simps(3)) definition get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) element_ptr \ (_) heap \ (_) Element option" - where + where "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h = Option.bind (get\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast element_ptr) h) cast" adhoc_overloading get get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t @@ -163,9 +173,9 @@ global_interpretation l_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^su by unfold_locales definition put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) element_ptr \ (_) Element \ (_) heap \ (_) heap" - where + where "put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element = put\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast element_ptr) (cast element)" -adhoc_overloading put put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t +adhoc_overloading put put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t lemma put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap: assumes "put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element h = h'" @@ -182,30 +192,30 @@ lemma put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_put_ptrs: -lemma cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inject [simp]: +lemma cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inject [simp]: "cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e x = cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e y \ x = y" apply(simp add: cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def) by (metis (full_types) RNode.surjective old.unit.exhaust) -lemma 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 [simp]: +lemma 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 [simp]: "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 node = None \ \ (\element. cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element = node)" - apply(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + apply(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits)[1] by (metis (full_types) RNode.select_convs(2) RNode.surjective old.unit.exhaust) -lemma 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_some [simp]: +lemma 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_some [simp]: "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 node = Some element \ cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element = node" - by(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + by(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits) lemma 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 [simp]: "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 (cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element) = Some element" by simp -lemma get_elment_ptr_simp1 [simp]: +lemma get_elment_ptr_simp1 [simp]: "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element h) = Some element" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_elment_ptr_simp2 [simp]: - "element_ptr \ element_ptr' +lemma get_elment_ptr_simp2 [simp]: + "element_ptr \ element_ptr' \ get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr' element h) = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) @@ -217,9 +227,9 @@ abbreviation "create_element_obj tag_name_arg child_nodes_arg attrs_arg shadow_r definition new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) heap \ ((_) element_ptr \ (_) heap)" where - "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = - (let new_element_ptr = element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref - |`| (element_ptrs h))))) + "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = + (let new_element_ptr = element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref + |`| (element_ptrs h))))) in (new_element_ptr, put new_element_ptr (create_element_obj '''' [] fmempty None) h))" @@ -230,7 +240,7 @@ lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap: unfolding new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def using put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap by blast -lemma new_element_ptr_new: +lemma new_element_ptr_new: "element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref |`| element_ptrs h)))) |\| element_ptrs h" by (metis Suc_n_not_le_n element_ptr.sel(1) fMax_ge fimage_finsert finsertI1 finsertI2 set_finsert) @@ -293,16 +303,20 @@ definition a_known_ptrs :: "(_) heap \ bool" where "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" -lemma known_ptrs_known_ptr: +lemma known_ptrs_known_ptr: "ptr |\| object_ptr_kinds h \ a_known_ptrs h \ known_ptr ptr" 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'" +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'" +lemma known_ptrs_subset: + "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 . diff --git a/Core_DOM/Core_DOM/standard/pointers/ShadowRootPointer.thy b/Core_DOM/Core_DOM/standard/pointers/ShadowRootPointer.thy index 97ead41..807d5ba 100644 --- a/Core_DOM/Core_DOM/standard/pointers/ShadowRootPointer.thy +++ b/Core_DOM/Core_DOM/standard/pointers/ShadowRootPointer.thy @@ -23,28 +23,28 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\ShadowRoot\ -text\In this theory, we introduce the typed pointers for the class ShadowRoot. Note that, in -this document, we will not make use of ShadowRoots nor will we discuss their particular properties. +text\In this theory, we introduce the typed pointers for the class ShadowRoot. Note that, in +this document, we will not make use of ShadowRoots nor will we discuss their particular properties. We only include them here, as they are required for future work and they cannot be added alter -following the object-oriented extensibility of our data model.\ +following the object-oriented extensibility of our data model.\ theory ShadowRootPointer imports "DocumentPointer" begin datatype 'shadow_root_ptr shadow_root_ptr = Ref (the_ref: ref) | Ext 'shadow_root_ptr -register_default_tvars "'shadow_root_ptr shadow_root_ptr" -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, +register_default_tvars "'shadow_root_ptr shadow_root_ptr" +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr) object_ptr - = "('shadow_root_ptr shadow_root_ptr + 'object_ptr, 'node_ptr, 'element_ptr, + = "('shadow_root_ptr shadow_root_ptr + 'object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, - 'document_ptr, 'shadow_root_ptr) object_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 @@ -57,7 +57,7 @@ definition cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\ definition 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 :: "(_) object_ptr \ (_) shadow_root_ptr option" where "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of - object_ptr.Ext (Inr (Inr (Inl shadow_root_ptr))) \ Some shadow_root_ptr + 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 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 @@ -65,13 +65,13 @@ adhoc_overloading cast cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^su definition is_shadow_root_ptr_kind :: "(_) object_ptr \ bool" where - "is_shadow_root_ptr_kind ptr = (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of Some _ \ True + "is_shadow_root_ptr_kind ptr = (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of Some _ \ True | None \ False)" consts is_shadow_root_ptr :: 'a definition is_shadow_root_ptr\<^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 \ bool" where - "is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of shadow_root_ptr.Ref _ \ True + "is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of shadow_root_ptr.Ref _ \ True | _ \ False)" abbreviation is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" @@ -92,16 +92,16 @@ adhoc_overloading is_shadow_root_ptr_ext is_shadow_root_ptr_ext\<^sub>o\<^sub>b\ instantiation shadow_root_ptr :: (linorder) linorder begin -definition +definition less_eq_shadow_root_ptr :: "(_::linorder) shadow_root_ptr \ (_) shadow_root_ptr \ bool" - where + where "less_eq_shadow_root_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j | Ref _ \ False) | Ref i \ (case y of Ext _ \ True | Ref j \ i \ j))" definition less_shadow_root_ptr :: "(_::linorder) shadow_root_ptr \ (_) shadow_root_ptr \ bool" where "less_shadow_root_ptr x y \ x \ y \ \ y \ x" -instance +instance apply(standard) - by(auto simp add: less_eq_shadow_root_ptr_def less_shadow_root_ptr_def + by(auto simp add: less_eq_shadow_root_ptr_def less_shadow_root_ptr_def split: shadow_root_ptr.splits) end @@ -122,21 +122,21 @@ lemma cast_shadow_root_ptr_not_document_ptr [simp]: "cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr \ cast\<^sub>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" unfolding 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_def 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_def by auto -lemma shadow_root_ptr_no_node_ptr_cast [simp]: +lemma shadow_root_ptr_no_node_ptr_cast [simp]: "\ is_shadow_root_ptr_kind (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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(simp add: cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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_def is_shadow_root_ptr_kind_def) -lemma node_ptr_no_shadow_root_ptr_cast [simp]: +lemma node_ptr_no_shadow_root_ptr_cast [simp]: "\ is_node_ptr_kind (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)" using is_node_ptr_kind_obtains by fastforce -lemma shadow_root_ptr_no_document_ptr_cast [simp]: +lemma shadow_root_ptr_no_document_ptr_cast [simp]: "\ is_shadow_root_ptr_kind (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)" by(simp add: 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_def 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_def is_shadow_root_ptr_kind_def) -lemma document_ptr_no_shadow_root_ptr_cast [simp]: +lemma document_ptr_no_shadow_root_ptr_cast [simp]: "\ is_document_ptr_kind (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)" using is_document_ptr_kind_obtains by fastforce -lemma shadow_root_ptr_shadow_root_ptr_cast [simp]: +lemma shadow_root_ptr_shadow_root_ptr_cast [simp]: "is_shadow_root_ptr_kind (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)" by (simp add: 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_def 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_def is_shadow_root_ptr_kind_def) @@ -145,7 +145,7 @@ lemma shadow_root_ptr_casts_commute [simp]: unfolding 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_def cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by(auto split: object_ptr.splits sum.splits) -lemma shadow_root_ptr_casts_commute2 [simp]: +lemma shadow_root_ptr_casts_commute2 [simp]: "(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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) = Some shadow_root_ptr)" by simp @@ -169,11 +169,11 @@ lemma is_shadow_root_ptr_kind_none: unfolding is_shadow_root_ptr_kind_def 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_def by (auto split: object_ptr.splits sum.splits) -lemma 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_inject [simp]: +lemma 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_inject [simp]: "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 x = 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 y \ x = y" by(simp add: 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_def) -lemma 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_ext_none [simp]: +lemma 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_ext_none [simp]: "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 (object_ptr.Ext (Inr (Inr (Inr object_ext_ptr)))) = None" by(simp add: 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_def) diff --git a/Core_DOM/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy b/Core_DOM/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy index f5b0c25..fd014d2 100644 --- a/Core_DOM/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy +++ b/Core_DOM/Core_SC_DOM/safely_composable/Core_DOM_Heap_WF.thy @@ -23,47 +23,52 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\Wellformedness\ -text\In this theory, we discuss the wellformedness of the DOM. First, we define -wellformedness and, second, we show for all functions for querying and modifying the +text\In this theory, we discuss the wellformedness of the DOM. First, we define +wellformedness and, second, we show for all functions for querying and modifying the DOM to what extend they preserve wellformendess.\ theory Core_DOM_Heap_WF -imports - "Core_DOM_Functions" + imports + "Core_DOM_Functions" begin locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = l_get_child_nodes_defs get_child_nodes get_child_nodes_locs + l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs for get_child_nodes :: "(_::linorder) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin definition a_owner_document_valid :: "(_) heap \ bool" where "a_owner_document_valid h \ (\node_ptr \ fset (node_ptr_kinds h). - ((\document_ptr. document_ptr |\| document_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 + \ (\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)))) + 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) \ + 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))))" + 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)) @@ -71,32 +76,42 @@ proof - 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" + 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)))" + 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))))" + 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 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))))" + 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" + 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 + "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 @@ -115,12 +130,13 @@ definition a_all_ptrs_in_heap :: "(_) heap \ bool" where "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))" + (\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 + where "a_distinct_lists h = distinct (concat ( - (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r) + (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r) @ (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r) ))" @@ -134,31 +150,31 @@ locale l_heap_is_wellformed_defs = fixes heap_is_wellformed :: "(_) heap \ bool" fixes parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" -global_interpretation l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs -defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes +global_interpretation l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + defines heap_is_wellformed = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_heap_is_wellformed get_child_nodes get_disconnected_nodes" - and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes" - and acyclic_heap = a_acyclic_heap - and all_ptrs_in_heap = a_all_ptrs_in_heap - and distinct_lists = a_distinct_lists - and owner_document_valid = a_owner_document_valid + and parent_child_rel = "l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_parent_child_rel get_child_nodes" + and acyclic_heap = a_acyclic_heap + and all_ptrs_in_heap = a_all_ptrs_in_heap + and distinct_lists = a_distinct_lists + and owner_document_valid = a_owner_document_valid . locale l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs - + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs + + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs + l_heap_is_wellformed_defs heap_is_wellformed parent_child_rel + l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed" assumes parent_child_rel_impl: "parent_child_rel = a_parent_child_rel" begin @@ -190,10 +206,10 @@ lemma parent_child_rel_child_nodes2: lemma parent_child_rel_finite: "finite (parent_child_rel h)" proof - - have "parent_child_rel h = (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. + have "parent_child_rel h = (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. (\child \ set |h \ get_child_nodes ptr|\<^sub>r. {(ptr, cast child)}))" by(auto simp add: parent_child_rel_def) - moreover have "finite (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. + moreover have "finite (\ptr \ set |h \ object_ptr_kinds_M|\<^sub>r. (\child \ set |h \ get_child_nodes ptr|\<^sub>r. {(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child)}))" by simp ultimately show ?thesis @@ -204,15 +220,15 @@ lemma distinct_lists_no_parent: assumes "a_distinct_lists h" assumes "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assumes "node_ptr \ set disc_nodes" - shows "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h + shows "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" using assms apply(auto simp add: a_distinct_lists_def)[1] proof - fix parent_ptr :: "(_) object_ptr" assume a1: "parent_ptr |\| object_ptr_kinds h" - assume a2: "(\x\fset (object_ptr_kinds h). - set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). + assume a2: "(\x\fset (object_ptr_kinds h). + set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). set |h \ get_disconnected_nodes x|\<^sub>r) = {}" assume a3: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assume a4: "node_ptr \ set disc_nodes" @@ -233,15 +249,15 @@ lemma distinct_lists_disconnected_nodes: and "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" shows "distinct disc_nodes" proof - - have h1: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + have h1: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using assms(1) by(simp add: a_distinct_lists_def) then show ?thesis using concat_map_all_distinct[OF h1] assms(2) is_OK_returns_result_I get_disconnected_nodes_ok - by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M - l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap - l_get_disconnected_nodes_axioms select_result_I2) + by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M + l_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap + l_get_disconnected_nodes_axioms select_result_I2) qed lemma distinct_lists_children: @@ -256,8 +272,8 @@ proof (cases "children = []", simp) by(simp add: a_distinct_lists_def) show ?thesis using concat_map_all_distinct[OF h1] assms(2) assms(3) - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap - is_OK_returns_result_I select_result_I2) + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M get_child_nodes_ptr_in_heap + is_OK_returns_result_I select_result_I2) qed lemma heap_is_wellformed_children_in_heap: @@ -267,7 +283,8 @@ 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 (metis (no_types, lifting) finite_set_in is_OK_returns_result_I local.get_child_nodes_ptr_in_heap select_result_I2 subsetD) + 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" @@ -281,55 +298,56 @@ proof (auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1] assume a1: "ptr \ ptr'" assume a2: "h \ get_child_nodes ptr \\<^sub>r children" assume a3: "h \ get_child_nodes ptr' \\<^sub>r children'" - assume a4: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) + assume a4: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))))" have f5: "|h \ get_child_nodes ptr|\<^sub>r = children" using a2 by simp have "|h \ get_child_nodes ptr'|\<^sub>r = children'" using a3 by (meson select_result_I2) - then have "ptr \ set (sorted_list_of_set (fset (object_ptr_kinds h))) - \ ptr' \ set (sorted_list_of_set (fset (object_ptr_kinds h))) + then have "ptr \ set (sorted_list_of_set (fset (object_ptr_kinds h))) + \ ptr' \ set (sorted_list_of_set (fset (object_ptr_kinds h))) \ set children \ set children' = {}" using f5 a4 a1 by (meson distinct_concat_map_E(1)) then show False - using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I - local.get_child_nodes_ptr_in_heap set_sorted_list_of_set) + using a3 a2 by (metis (no_types) assms(4) finite_fset fmember.rep_eq is_OK_returns_result_I + local.get_child_nodes_ptr_in_heap set_sorted_list_of_set) qed -lemma parent_child_rel_child: +lemma parent_child_rel_child: "h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ (ptr, cast child) \ parent_child_rel h" by (simp add: is_OK_returns_result_I get_child_nodes_ptr_in_heap parent_child_rel_def) lemma parent_child_rel_acyclic: "heap_is_wellformed h \ acyclic (parent_child_rel h)" by (simp add: acyclic_heap_def local.heap_is_wellformed_def) -lemma heap_is_wellformed_disconnected_nodes_distinct: +lemma heap_is_wellformed_disconnected_nodes_distinct: "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ distinct disc_nodes" using distinct_lists_disconnected_nodes local.heap_is_wellformed_def by blast -lemma parent_child_rel_parent_in_heap: +lemma parent_child_rel_parent_in_heap: "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" using local.parent_child_rel_def by blast -lemma parent_child_rel_child_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptr parent +lemma parent_child_rel_child_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptr parent \ (parent, child_ptr) \ parent_child_rel h \ child_ptr |\| object_ptr_kinds h" apply(auto simp add: heap_is_wellformed_def parent_child_rel_def a_all_ptrs_in_heap_def)[1] using get_child_nodes_ok by (meson finite_set_in subsetD) -lemma heap_is_wellformed_disc_nodes_in_heap: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes +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 (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) + 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 - \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' +lemma heap_is_wellformed_one_disc_parent: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' \ set disc_nodes \ set disc_nodes' \ {} \ document_ptr = document_ptr'" - using DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1) - is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap - local.heap_is_wellformed_def select_result_I2 + using DocumentMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append distinct_concat_map_E(1) + is_OK_returns_result_I local.a_distinct_lists_def local.get_disconnected_nodes_ptr_in_heap + local.heap_is_wellformed_def select_result_I2 proof - assume a1: "heap_is_wellformed h" assume a2: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" @@ -344,117 +362,117 @@ proof - then have "distinct (concat (map (\d. |h \ get_disconnected_nodes d|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using a1 local.a_distinct_lists_def local.heap_is_wellformed_def by blast then show ?thesis - using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1) - is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) + using f6 f5 a4 a3 a2 by (meson DocumentMonad.ptr_kinds_ptr_kinds_M distinct_concat_map_E(1) + is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) qed -lemma heap_is_wellformed_children_disc_nodes_different: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes +lemma heap_is_wellformed_children_disc_nodes_different: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ set children \ set disc_nodes = {}" - by (metis (no_types, hide_lams) disjoint_iff_not_equal distinct_lists_no_parent - is_OK_returns_result_I local.get_child_nodes_ptr_in_heap - local.heap_is_wellformed_def select_result_I2) + by (metis (no_types, hide_lams) disjoint_iff_not_equal distinct_lists_no_parent + is_OK_returns_result_I local.get_child_nodes_ptr_in_heap + local.heap_is_wellformed_def select_result_I2) -lemma heap_is_wellformed_children_disc_nodes: - "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h - \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) +lemma heap_is_wellformed_children_disc_nodes: + "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h + \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) \ (\document_ptr \ fset (document_ptr_kinds h). node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def a_owner_document_valid_def)[1] by (meson fmember.rep_eq) -lemma heap_is_wellformed_children_distinct: +lemma heap_is_wellformed_children_distinct: "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append - distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def - local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def - select_result_I2) + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M concat_append distinct_append + distinct_concat_map_E(2) is_OK_returns_result_I local.a_distinct_lists_def + local.get_child_nodes_ptr_in_heap local.heap_is_wellformed_def + select_result_I2) end -locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + -assumes heap_is_wellformed_children_in_heap: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ child \ set children +locale l_heap_is_wellformed = l_type_wf + l_known_ptr + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + + assumes heap_is_wellformed_children_in_heap: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ child |\| node_ptr_kinds h" -assumes heap_is_wellformed_disc_nodes_in_heap: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes 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" -assumes heap_is_wellformed_one_parent: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_child_nodes ptr' \\<^sub>r children' + assumes heap_is_wellformed_one_parent: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_child_nodes ptr' \\<^sub>r children' \ set children \ set children' \ {} \ ptr = ptr'" -assumes heap_is_wellformed_one_disc_parent: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes - \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' + assumes heap_is_wellformed_one_disc_parent: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + \ h \ get_disconnected_nodes document_ptr' \\<^sub>r disc_nodes' \ set disc_nodes \ set disc_nodes' \ {} \ document_ptr = document_ptr'" -assumes heap_is_wellformed_children_disc_nodes_different: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes heap_is_wellformed_children_disc_nodes_different: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ set children \ set disc_nodes = {}" -assumes heap_is_wellformed_disconnected_nodes_distinct: - "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes + assumes heap_is_wellformed_disconnected_nodes_distinct: + "heap_is_wellformed h \ h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes \ distinct disc_nodes" -assumes heap_is_wellformed_children_distinct: - "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" -assumes heap_is_wellformed_children_disc_nodes: - "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h - \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) + assumes heap_is_wellformed_children_distinct: + "heap_is_wellformed h \ h \ get_child_nodes ptr \\<^sub>r children \ distinct children" + assumes heap_is_wellformed_children_disc_nodes: + "heap_is_wellformed h \ node_ptr |\| node_ptr_kinds h + \ \(\parent \ fset (object_ptr_kinds h). node_ptr \ set |h \ get_child_nodes parent|\<^sub>r) \ (\document_ptr \ fset (document_ptr_kinds h). node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r)" -assumes parent_child_rel_child: - "h \ get_child_nodes ptr \\<^sub>r children + assumes parent_child_rel_child: + "h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ (ptr, cast child) \ parent_child_rel h" -assumes parent_child_rel_finite: - "heap_is_wellformed h \ finite (parent_child_rel h)" -assumes parent_child_rel_acyclic: - "heap_is_wellformed h \ acyclic (parent_child_rel h)" -assumes parent_child_rel_node_ptr: - "(parent, child_ptr) \ parent_child_rel h \ is_node_ptr_kind child_ptr" -assumes parent_child_rel_parent_in_heap: - "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" -assumes parent_child_rel_child_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptr parent + assumes parent_child_rel_finite: + "heap_is_wellformed h \ finite (parent_child_rel h)" + assumes parent_child_rel_acyclic: + "heap_is_wellformed h \ acyclic (parent_child_rel h)" + assumes parent_child_rel_node_ptr: + "(parent, child_ptr) \ parent_child_rel h \ is_node_ptr_kind child_ptr" + assumes parent_child_rel_parent_in_heap: + "(parent, child_ptr) \ parent_child_rel h \ parent |\| object_ptr_kinds h" + assumes parent_child_rel_child_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptr parent \ (parent, child_ptr) \ parent_child_rel h \ child_ptr |\| object_ptr_kinds h" -interpretation i_heap_is_wellformed?: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel +interpretation i_heap_is_wellformed?: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel apply(unfold_locales) by(auto simp add: heap_is_wellformed_def parent_child_rel_def) declare l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma heap_is_wellformed_is_l_heap_is_wellformed [instances]: - "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes + "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes" apply(auto simp add: l_heap_is_wellformed_def)[1] - using heap_is_wellformed_children_in_heap + using heap_is_wellformed_children_in_heap apply blast - using heap_is_wellformed_disc_nodes_in_heap + using heap_is_wellformed_disc_nodes_in_heap apply blast - using heap_is_wellformed_one_parent + using heap_is_wellformed_one_parent apply blast - using heap_is_wellformed_one_disc_parent + using heap_is_wellformed_one_disc_parent apply blast - using heap_is_wellformed_children_disc_nodes_different + using heap_is_wellformed_children_disc_nodes_different apply blast - using heap_is_wellformed_disconnected_nodes_distinct + using heap_is_wellformed_disconnected_nodes_distinct apply blast - using heap_is_wellformed_children_distinct + using heap_is_wellformed_children_distinct apply blast - using heap_is_wellformed_children_disc_nodes + using heap_is_wellformed_children_disc_nodes apply blast - using parent_child_rel_child + using parent_child_rel_child apply (blast) - using parent_child_rel_child + using parent_child_rel_child apply(blast) - using parent_child_rel_finite + using parent_child_rel_finite apply blast - using parent_child_rel_acyclic + using parent_child_rel_acyclic apply blast - using parent_child_rel_node_ptr + using parent_child_rel_node_ptr apply blast - using parent_child_rel_parent_in_heap + using parent_child_rel_parent_in_heap apply blast - using parent_child_rel_child_in_heap + using parent_child_rel_child_in_heap apply blast done @@ -462,21 +480,21 @@ subsection \get\_parent\ locale l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma child_parent_dual: assumes heap_is_wellformed: "heap_is_wellformed h" @@ -489,10 +507,10 @@ proof - obtain ptrs where ptrs: "h \ object_ptr_kinds_M \\<^sub>r ptrs" by(simp add: object_ptr_kinds_M_defs) then have h1: "ptr \ set ptrs" - using get_child_nodes_ok assms(2) is_OK_returns_result_I - by (metis (no_types, hide_lams) ObjectMonad.ptr_kinds_ptr_kinds_M - \\thesis. (\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs \ thesis) \ thesis\ - get_child_nodes_ptr_in_heap returns_result_eq select_result_I2) + using get_child_nodes_ok assms(2) is_OK_returns_result_I + by (metis (no_types, hide_lams) ObjectMonad.ptr_kinds_ptr_kinds_M + \\thesis. (\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs \ thesis) \ thesis\ + get_child_nodes_ptr_in_heap returns_result_eq select_result_I2) let ?P = "(\ptr. get_child_nodes ptr \ (\children. return (child \ set children)))" let ?filter = "filter_M ?P ptrs" @@ -501,50 +519,50 @@ proof - using ptrs type_wf using get_child_nodes_ok apply(auto intro!: filter_M_is_OK_I bind_is_OK_pure_I get_child_nodes_ok simp add: bind_pure_I)[1] - using assms(4) local.known_ptrs_known_ptr by blast + using assms(4) local.known_ptrs_known_ptr by blast then obtain parent_ptrs where parent_ptrs: "h \ ?filter \\<^sub>r parent_ptrs" by auto - have h5: "\!x. x \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes x) + have h5: "\!x. x \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (child \ set children)) \\<^sub>r True" apply(auto intro!: bind_pure_returns_result_I)[1] using heap_is_wellformed_one_parent proof - have "h \ (return (child \ set children)::((_) heap, exception, bool) prog) \\<^sub>r True" by (simp add: assms(3)) - then show - "\z. z \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes z) + then show + "\z. z \ set ptrs \ h \ Heap_Error_Monad.bind (get_child_nodes z) (\ns. return (child \ set ns)) \\<^sub>r True" - by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I - local.get_child_nodes_pure select_result_I2) + by (metis (no_types) assms(2) bind_pure_returns_result_I2 h1 is_OK_returns_result_I + local.get_child_nodes_pure select_result_I2) next fix x y assume 0: "x \ set ptrs" - and 1: "h \ Heap_Error_Monad.bind (get_child_nodes x) + and 1: "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (child \ set children)) \\<^sub>r True" and 2: "y \ set ptrs" - and 3: "h \ Heap_Error_Monad.bind (get_child_nodes y) + and 3: "h \ Heap_Error_Monad.bind (get_child_nodes y) (\children. return (child \ set children)) \\<^sub>r True" - and 4: "(\h ptr children ptr' children'. heap_is_wellformed h - \ h \ get_child_nodes ptr \\<^sub>r children \ h \ get_child_nodes ptr' \\<^sub>r children' + and 4: "(\h ptr children ptr' children'. heap_is_wellformed h + \ h \ get_child_nodes ptr \\<^sub>r children \ h \ get_child_nodes ptr' \\<^sub>r children' \ set children \ set children' \ {} \ ptr = ptr')" then show "x = y" - by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed - return_returns_result) + by (metis (no_types, lifting) bind_returns_result_E disjoint_iff_not_equal heap_is_wellformed + return_returns_result) qed have "child |\| node_ptr_kinds h" using heap_is_wellformed_children_in_heap heap_is_wellformed assms(2) assms(3) - by fast + by fast moreover have "parent_ptrs = [ptr]" apply(rule filter_M_ex1[OF parent_ptrs h1 h5]) - using ptrs assms(2) assms(3) + using ptrs assms(2) assms(3) by(auto simp add: object_ptr_kinds_M_defs bind_pure_I intro!: bind_pure_returns_result_I) ultimately show ?thesis using ptrs parent_ptrs - by(auto simp add: bind_pure_I get_parent_def - elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *) + by(auto simp add: bind_pure_I get_parent_def + elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I) (*slow, ca 1min *) qed lemma parent_child_rel_parent: @@ -555,7 +573,7 @@ lemma parent_child_rel_parent: lemma heap_wellformed_induct [consumes 1, case_names step]: assumes "heap_is_wellformed h" - and step: "\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children + and step: "\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child)) \ P parent" shows "P ptr" proof - @@ -575,7 +593,7 @@ lemma heap_wellformed_induct2 [consumes 3, case_names not_in_heap empty_children assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" and not_in_heap: "\parent. parent |\| object_ptr_kinds h \ P parent" and empty_children: "\parent. h \ get_child_nodes parent \\<^sub>r [] \ P parent" - and step: "\parent children child. h \ get_child_nodes parent \\<^sub>r children + and step: "\parent children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child) \ P parent" shows "P ptr" proof(insert assms(1), induct rule: heap_wellformed_induct) @@ -584,7 +602,7 @@ proof(insert assms(1), induct rule: heap_wellformed_induct) proof(cases "parent |\| object_ptr_kinds h") case True then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" - using get_child_nodes_ok assms(2) assms(3) + using get_child_nodes_ok assms(2) assms(3) by (meson is_OK_returns_result_E local.known_ptrs_known_ptr) then show ?thesis proof (cases "children = []") @@ -599,21 +617,21 @@ proof(insert assms(1), induct rule: heap_wellformed_induct) qed next case False - then show ?thesis + then show ?thesis by (simp add: not_in_heap) qed qed lemma heap_wellformed_induct_rev [consumes 1, case_names step]: assumes "heap_is_wellformed h" - and step: "\child. (\parent child_node. cast child_node = child + and step: "\child. (\parent child_node. cast child_node = child \ h \ get_parent child_node \\<^sub>r Some parent \ P parent) \ P child" shows "P ptr" proof - fix ptr have "wf ((parent_child_rel h))" - by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite - wf_iff_acyclic_if_finite) + by (simp add: assms(1) local.parent_child_rel_acyclic local.parent_child_rel_finite + wf_iff_acyclic_if_finite) then show "?thesis" proof (induct rule: wf_induct_rule) @@ -625,9 +643,9 @@ proof - qed end -interpretation i_get_parent_wf?: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed - parent_child_rel get_disconnected_nodes +interpretation i_get_parent_wf?: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed + parent_child_rel get_disconnected_nodes using instances by(simp add: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] @@ -635,43 +653,43 @@ declare l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ locale l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs - heap_is_wellformed parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + heap_is_wellformed parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and known_ptrs :: "(_) heap \ bool" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and known_ptrs :: "(_) heap \ bool" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma preserves_wellformedness_writes_needed: assumes heap_is_wellformed: "heap_is_wellformed h" and "h \ f \\<^sub>h h'" and "writes SW f h h'" - and preserved_get_child_nodes: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_get_child_nodes: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. \r \ get_child_nodes_locs object_ptr. r h h'" - and preserved_get_disconnected_nodes: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_get_disconnected_nodes: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \document_ptr. \r \ get_disconnected_nodes_locs document_ptr. r h h'" - and preserved_object_pointers: - "\h h' w. w \ SW \ h \ w \\<^sub>h h' + and preserved_object_pointers: + "\h h' w. w \ SW \ h \ w \\<^sub>h h' \ \object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'" -shows "heap_is_wellformed h'" + shows "heap_is_wellformed h'" proof - have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" using assms(2) assms(3) object_ptr_kinds_preserved preserved_object_pointers by blast - then have object_ptr_kinds_eq: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" - unfolding object_ptr_kinds_M_defs by simp + then have object_ptr_kinds_eq: + "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + unfolding object_ptr_kinds_M_defs by simp then have object_ptr_kinds_eq2: "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" using select_result_eq by force then have node_ptr_kinds_eq2: "|h \ node_ptr_kinds_M|\<^sub>r = |h' \ node_ptr_kinds_M|\<^sub>r" @@ -681,21 +699,21 @@ proof - have document_ptr_kinds_eq2: "|h \ document_ptr_kinds_M|\<^sub>r = |h' \ document_ptr_kinds_M|\<^sub>r" using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" - by auto - have children_eq: + by auto + have children_eq: "\ptr children. h \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" apply(rule reads_writes_preserved[OF get_child_nodes_reads assms(3) assms(2)]) using preserved_get_child_nodes by fast then have children_eq2: "\ptr. |h \ get_child_nodes ptr|\<^sub>r = |h' \ get_child_nodes ptr|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: - "\document_ptr disconnected_nodes. - h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes + have disconnected_nodes_eq: + "\document_ptr disconnected_nodes. + h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads assms(3) assms(2)]) using preserved_get_disconnected_nodes by fast - then have disconnected_nodes_eq2: - "\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r + then have disconnected_nodes_eq2: + "\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force have get_parent_eq: "\ptr parent. h \ get_parent ptr \\<^sub>r parent = h' \ get_parent ptr \\<^sub>r parent" @@ -716,42 +734,43 @@ 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 (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) + by (simp add: children_eq2 disconnected_nodes_eq2 document_ptr_kinds_eq3 + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_all_ptrs_in_heap_def node_ptr_kinds_eq3 object_ptr_kinds_eq3) moreover have h0: "a_distinct_lists h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) - have h1: "map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h))) + have h1: "map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h))) = map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))" - by (simp add: children_eq2 object_ptr_kinds_eq3) - have h2: "map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) - (sorted_list_of_set (fset (document_ptr_kinds h))) - = map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + by (simp add: children_eq2 object_ptr_kinds_eq3) + have h2: "map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + (sorted_list_of_set (fset (document_ptr_kinds h))) + = map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))" using disconnected_nodes_eq document_ptr_kinds_eq2 select_result_eq by force have "a_distinct_lists h'" - using h0 + using h0 by(simp add: a_distinct_lists_def h1 h2) moreover have "a_owner_document_valid h" using heap_is_wellformed by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" - by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2 - object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3) + by(auto simp add: a_owner_document_valid_def children_eq2 disconnected_nodes_eq2 + object_ptr_kinds_eq3 node_ptr_kinds_eq3 document_ptr_kinds_eq3) ultimately show ?thesis by (simp add: heap_is_wellformed_def) qed end -interpretation i_get_parent_wf2?: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs get_parent get_parent_locs - heap_is_wellformed parent_child_rel get_disconnected_nodes - get_disconnected_nodes_locs +interpretation i_get_parent_wf2?: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs get_parent get_parent_locs + heap_is_wellformed parent_child_rel get_disconnected_nodes + get_disconnected_nodes_locs using l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms by (simp add: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_get_parent_defs + +locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_get_parent_defs + assumes child_parent_dual: "heap_is_wellformed h \ type_wf h @@ -761,25 +780,25 @@ locale l_get_parent_wf = l_type_wf + l_known_ptrs + l_heap_is_wellformed_defs \ h \ get_parent child \\<^sub>r Some ptr" assumes heap_wellformed_induct [consumes 1, case_names step]: "heap_is_wellformed h - \ (\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children + \ (\parent. (\children child. h \ get_child_nodes parent \\<^sub>r children \ child \ set children \ P (cast child)) \ P parent) \ P ptr" assumes heap_wellformed_induct_rev [consumes 1, case_names step]: "heap_is_wellformed h - \ (\child. (\parent child_node. cast child_node = child + \ (\child. (\parent child_node. cast child_node = child \ h \ get_parent child_node \\<^sub>r Some parent \ P parent) \ P child) \ P ptr" - assumes parent_child_rel_parent: "heap_is_wellformed h - \ h \ get_parent child_node \\<^sub>r Some parent + assumes parent_child_rel_parent: "heap_is_wellformed h + \ h \ get_parent child_node \\<^sub>r Some parent \ (parent, cast child_node) \ parent_child_rel h" -lemma get_parent_wf_is_l_get_parent_wf [instances]: - "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel +lemma get_parent_wf_is_l_get_parent_wf [instances]: + "l_get_parent_wf type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def)[1] using child_parent_dual heap_wellformed_induct heap_wellformed_induct_rev parent_child_rel_parent - by metis+ + by metis+ @@ -794,21 +813,21 @@ subsubsection \get\_disconnected\_nodes\ locale l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_set_disconnected_nodes_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs for known_ptr :: "(_) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and 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 heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and 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 heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" begin lemma remove_from_disconnected_nodes_removes: @@ -818,33 +837,33 @@ lemma remove_from_disconnected_nodes_removes: assumes "h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes'" shows "node_ptr \ set disc_nodes'" using assms - by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct - set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1) - returns_result_eq) + by (metis distinct_remove1_removeAll heap_is_wellformed_disconnected_nodes_distinct + set_disconnected_nodes_get_disconnected_nodes member_remove remove_code(1) + returns_result_eq) end locale l_set_disconnected_nodes_get_disconnected_nodes_wf = l_heap_is_wellformed - + l_set_disconnected_nodes_get_disconnected_nodes + + + l_set_disconnected_nodes_get_disconnected_nodes + assumes remove_from_disconnected_nodes_removes: - "heap_is_wellformed h \ h \ get_disconnected_nodes ptr \\<^sub>r disc_nodes - \ h \ set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \\<^sub>h h' - \ h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes' + "heap_is_wellformed h \ h \ get_disconnected_nodes ptr \\<^sub>r disc_nodes + \ h \ set_disconnected_nodes ptr (remove1 node_ptr disc_nodes) \\<^sub>h h' + \ h' \ get_disconnected_nodes ptr \\<^sub>r disc_nodes' \ node_ptr \ set disc_nodes'" interpretation i_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M?: - l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs heap_is_wellformed + l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs heap_is_wellformed parent_child_rel get_child_nodes using instances by (simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] - + lemma set_disconnected_nodes_get_disconnected_nodes_wf_is_l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]: - "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformed parent_child_rel + "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs" - apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def - l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1] + apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def + l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1] using remove_from_disconnected_nodes_removes apply fast done @@ -853,31 +872,31 @@ subsection \get\_root\_node\ locale l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed - type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs + type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + known_ptr type_wf get_child_nodes get_child_nodes_locs known_ptrs get_parent get_parent_locs + l_get_parent_wf - type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes - get_child_nodes_locs get_parent get_parent_locs + type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel get_child_nodes + get_child_nodes_locs get_parent get_parent_locs + l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs - get_ancestors get_ancestors_locs get_root_node get_root_node_locs + type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs + get_ancestors get_ancestors_locs get_root_node get_root_node_locs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and known_ptrs :: "(_) heap \ bool" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" - and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" - and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" - and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" - and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" - and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" + and type_wf :: "(_) heap \ bool" + and known_ptrs :: "(_) heap \ bool" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_parent :: "(_) node_ptr \ ((_) heap, exception, (_) object_ptr option) prog" + and get_parent_locs :: "((_) heap \ (_) heap \ bool) set" + and get_ancestors :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr list) prog" + and get_ancestors_locs :: "((_) heap \ (_) heap \ bool) set" + and get_root_node :: "(_) object_ptr \ ((_) heap, exception, (_) object_ptr) prog" + and get_root_node_locs :: "((_) heap \ (_) heap \ bool) set" begin lemma get_ancestors_reads: @@ -888,10 +907,10 @@ proof (insert assms(1), induct rule: heap_wellformed_induct_rev) then show ?case using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def] apply(simp (no_asm) add: get_ancestors_def) - by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers - intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] - reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads] - split: option.splits) + by(auto simp add: get_ancestors_locs_def reads_subset[OF return_reads] get_parent_reads_pointers + intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] + reads_subset[OF get_parent_reads] reads_subset[OF get_child_nodes_reads] + split: option.splits) qed lemma get_ancestors_ok: @@ -930,13 +949,13 @@ lemma get_root_node_ok: lemma get_ancestors_parent: assumes "heap_is_wellformed h" and "h \ get_parent child \\<^sub>r Some parent" - shows "h \ get_ancestors (cast child) \\<^sub>r (cast child) # parent # ancestors + shows "h \ get_ancestors (cast child) \\<^sub>r (cast child) # parent # ancestors \ h \ get_ancestors parent \\<^sub>r parent # ancestors" proof assume a1: "h \ get_ancestors (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" then have "h \ Heap_Error_Monad.bind (check_in_heap (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child)) (\_. Heap_Error_Monad.bind (get_parent child) - (\x. Heap_Error_Monad.bind (case x of None \ return [] | Some x \ get_ancestors x) + (\x. Heap_Error_Monad.bind (case x of None \ return [] | Some x \ get_ancestors x) (\ancestors. return (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # ancestors)))) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" by(simp add: get_ancestors_def) @@ -946,12 +965,12 @@ proof next assume "h \ get_ancestors parent \\<^sub>r parent # ancestors" then show "h \ get_ancestors (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child # parent # ancestors" - using assms(2) + using assms(2) apply(simp (no_asm) add: get_ancestors_def) apply(auto intro!: bind_pure_returns_result_I split: option.splits)[1] - by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I - local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust - select_result_I) + by (metis (full_types) assms(2) check_in_heap_ptr_in_heap is_OK_returns_result_I + local.get_parent_ptr_in_heap node_ptr_kinds_commutes old.unit.exhaust + select_result_I) qed @@ -975,12 +994,12 @@ proof(insert assms(2), induct arbitrary: ancestors rule: heap_wellformed_induct_ with Some show ?case proof(induct parent_opt) case None - then show ?case + then show ?case apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits) next case (Some option) - then show ?case + then show ?case apply(simp add: get_ancestors_def) by(auto elim!: bind_returns_result_E2 split: option.splits) qed @@ -994,21 +1013,21 @@ lemma get_ancestors_subset: and "h \ get_ancestors ptr \\<^sub>r ancestors" and "ancestor \ set ancestors" and "h \ get_ancestors ancestor \\<^sub>r ancestor_ancestors" -and type_wf: "type_wf h" -and known_ptrs: "known_ptrs h" + and type_wf: "type_wf h" + and known_ptrs: "known_ptrs h" shows "set ancestor_ancestors \ set ancestors" -proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors - rule: heap_wellformed_induct_rev) +proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors + rule: heap_wellformed_induct_rev) case (step child) have "child |\| object_ptr_kinds h" using get_ancestors_ptr_in_heap step(2) by auto - (* then have "h \ check_in_heap child \\<^sub>r ()" + (* then have "h \ check_in_heap child \\<^sub>r ()" using returns_result_select_result by force *) show ?case proof (induct "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child") case None then have "ancestors = [child]" - using step(2) step(3) + using step(2) step(3) by(auto simp add: get_ancestors_def elim!: bind_returns_result_E2) show ?case using step(2) step(3) @@ -1019,8 +1038,8 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors note s1 = Some obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" using \child |\| object_ptr_kinds h\ assms(1) Some[symmetric] get_parent_ok[OF type_wf known_ptrs] - by (metis (no_types, lifting) is_OK_returns_result_E known_ptrs get_parent_ok - l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_casts_commute node_ptr_kinds_commutes) + by (metis (no_types, lifting) is_OK_returns_result_E known_ptrs get_parent_ok + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_casts_commute node_ptr_kinds_commutes) then show ?case proof (induct parent_opt) case None @@ -1037,8 +1056,8 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors have "h \ Heap_Error_Monad.bind (check_in_heap child) (\_. Heap_Error_Monad.bind (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child of None \ return [] - | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) - (\parent_ptr_opt. case parent_ptr_opt of None \ return [] + | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) + (\parent_ptr_opt. case parent_ptr_opt of None \ return [] | Some x \ get_ancestors x)) (\ancestors. return (child # ancestors))) \\<^sub>r ancestors" @@ -1051,8 +1070,8 @@ proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors using s1 Some by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq) show ?case - using step(1)[OF s1[symmetric, simplified] Some \h \ get_ancestors parent \\<^sub>r tl_ancestors\] - step(3) + using step(1)[OF s1[symmetric, simplified] Some \h \ get_ancestors parent \\<^sub>r tl_ancestors\] + step(3) apply(auto simp add: tl_ancestors)[1] by (metis assms(4) insert_iff list.simps(15) local.step(2) returns_result_eq tl_ancestors) qed @@ -1069,13 +1088,13 @@ lemma get_ancestors_also_parent: shows "parent \ set ancestors" proof - obtain child_ancestors where child_ancestors: "h \ get_ancestors (cast child) \\<^sub>r child_ancestors" - by (meson assms(1) assms(4) get_ancestors_ok is_OK_returns_result_I known_ptrs - local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result - type_wf) + by (meson assms(1) assms(4) get_ancestors_ok is_OK_returns_result_I known_ptrs + local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result + type_wf) then have "parent \ set child_ancestors" apply(simp add: get_ancestors_def) - by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)] - get_ancestors_ptr) + by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)] + get_ancestors_ptr) then show ?thesis using assms child_ancestors get_ancestors_subset by blast qed @@ -1087,16 +1106,16 @@ lemma get_ancestors_obtains_children: and "h \ get_ancestors ptr \\<^sub>r ancestors" and type_wf: "type_wf h" and known_ptrs: "known_ptrs h" - obtains children ancestor_child where "h \ get_child_nodes ancestor \\<^sub>r children" + obtains children ancestor_child where "h \ get_child_nodes ancestor \\<^sub>r children" and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" proof - assume 0: "(\children ancestor_child. h \ get_child_nodes ancestor \\<^sub>r children \ - ancestor_child \ set children \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ancestor_child \ set ancestors + ancestor_child \ set children \ cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ancestor_child \ set ancestors \ thesis)" have "\child. h \ get_parent child \\<^sub>r Some ancestor \ cast child \ set ancestors" - proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors - rule: heap_wellformed_induct_rev) + proof (insert assms(1) assms(2) assms(3) assms(4), induct ptr arbitrary: ancestors + rule: heap_wellformed_induct_rev) case (step child) have "child |\| object_ptr_kinds h" using get_ancestors_ptr_in_heap step(4) by auto @@ -1115,8 +1134,8 @@ proof - obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" using \child |\| object_ptr_kinds h\ assms(1) Some[symmetric] using get_parent_ok known_ptrs type_wf - by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute - node_ptr_kinds_commutes) + by (metis (no_types, lifting) is_OK_returns_result_E node_ptr_casts_commute + node_ptr_kinds_commutes) then show ?case proof (induct parent_opt) case None @@ -1132,8 +1151,8 @@ proof - have "h \ Heap_Error_Monad.bind (check_in_heap child) (\_. Heap_Error_Monad.bind (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child of None \ return [] - | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) - (\parent_ptr_opt. case parent_ptr_opt of None \ return [] + | Some node_ptr \ Heap_Error_Monad.bind (get_parent node_ptr) + (\parent_ptr_opt. case parent_ptr_opt of None \ return [] | Some x \ get_ancestors x)) (\ancestors. return (child # ancestors))) \\<^sub>r ancestors" @@ -1145,15 +1164,15 @@ proof - ultimately have "h \ get_ancestors parent \\<^sub>r tl_ancestors" using s1 Some by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq) - (* have "ancestor \ parent" *) + (* have "ancestor \ parent" *) have "ancestor \ set tl_ancestors" using tl_ancestors step(2) step(3) by auto show ?case proof (cases "ancestor \ parent") case True - show ?thesis - using step(1)[OF s1[symmetric, simplified] Some True - \ancestor \ set tl_ancestors\ \h \ get_ancestors parent \\<^sub>r tl_ancestors\] + show ?thesis + using step(1)[OF s1[symmetric, simplified] Some True + \ancestor \ set tl_ancestors\ \h \ get_ancestors parent \\<^sub>r tl_ancestors\] using tl_ancestors by auto next case False @@ -1165,8 +1184,8 @@ proof - qed qed qed - then obtain child where child: "h \ get_parent child \\<^sub>r Some ancestor" - and in_ancestors: "cast child \ set ancestors" + then obtain child where child: "h \ get_parent child \\<^sub>r Some ancestor" + and in_ancestors: "cast child \ set ancestors" by auto then obtain children where children: "h \ get_child_nodes ancestor \\<^sub>r children" and @@ -1181,7 +1200,7 @@ lemma get_ancestors_parent_child_rel: and "h \ get_ancestors child \\<^sub>r ancestors" and known_ptrs: "known_ptrs h" and type_wf: "type_wf h" -shows "(ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" + shows "(ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" proof (safe) assume 3: "(ptr, child) \ (parent_child_rel h)\<^sup>*" show "ptr \ set ancestors" @@ -1192,33 +1211,33 @@ proof (safe) case True then show ?thesis by (metis (no_types, lifting) assms(2) bind_returns_result_E get_ancestors_def - in_set_member member_rec(1) return_returns_result) + in_set_member member_rec(1) return_returns_result) next case False obtain ptr_child where ptr_child: "(ptr, ptr_child) \ (parent_child_rel h) \ (ptr_child, child) \ (parent_child_rel h)\<^sup>*" using converse_rtranclE[OF 1(2)] \ptr \ child\ by metis - then obtain ptr_child_node - where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node" + then obtain ptr_child_node + where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node" using ptr_child node_ptr_casts_commute3 parent_child_rel_node_ptr by (metis ) then obtain children where children: "h \ get_child_nodes ptr \\<^sub>r children" and ptr_child_node: "ptr_child_node \ set children" proof - - assume a1: "\children. \h \ get_child_nodes ptr \\<^sub>r children; ptr_child_node \ set children\ + assume a1: "\children. \h \ get_child_nodes ptr \\<^sub>r children; ptr_child_node \ set children\ \ thesis" - + have "ptr |\| object_ptr_kinds h" using local.parent_child_rel_parent_in_heap ptr_child by blast moreover have "ptr_child_node \ set |h \ get_child_nodes ptr|\<^sub>r" - by (metis calculation known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr - local.parent_child_rel_child ptr_child ptr_child_ptr_child_node - returns_result_select_result type_wf) + by (metis calculation known_ptrs local.get_child_nodes_ok local.known_ptrs_known_ptr + local.parent_child_rel_child ptr_child ptr_child_ptr_child_node + returns_result_select_result type_wf) ultimately show ?thesis using a1 get_child_nodes_ok type_wf known_ptrs - by (meson local.known_ptrs_known_ptr returns_result_select_result) + by (meson local.known_ptrs_known_ptr returns_result_select_result) qed moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \ (parent_child_rel h)\<^sup>*" using ptr_child ptr_child_ptr_child_node by auto @@ -1226,12 +1245,12 @@ proof (safe) using 1 by auto moreover have "h \ get_parent ptr_child_node \\<^sub>r Some ptr" using assms(1) children ptr_child_node child_parent_dual - using known_ptrs type_wf by blast + using known_ptrs type_wf by blast ultimately show ?thesis using get_ancestors_also_parent assms type_wf by blast qed qed - next +next assume 3: "ptr \ set ancestors" show "(ptr, child) \ (parent_child_rel h)\<^sup>*" proof (insert 3, induct ptr rule: heap_wellformed_induct[OF assms(1)]) @@ -1251,12 +1270,12 @@ proof (safe) using known_ptrs type_wf by blast then have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \ (parent_child_rel h)\<^sup>*" using 1(1) by blast - + moreover have "(ptr, cast ptr_child_node) \ parent_child_rel h" using children ptr_child_node assms(1) parent_child_rel_child_nodes2 using child_parent_dual known_ptrs parent_child_rel_parent type_wf by blast - + ultimately show ?thesis by auto qed @@ -1288,15 +1307,15 @@ lemma get_ancestors_eq: proof - have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" using pointers_preserved object_ptr_kinds_preserved_small by blast - then have object_ptr_kinds_M_eq: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" + then have object_ptr_kinds_M_eq: + "\ptrs. h \ 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_eq: "|h \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" by(simp) have "h' \ ok (get_ancestors ptr)" using get_ancestors_ok get_ancestors_ptr_in_heap object_ptr_kinds_eq3 assms(1) known_ptrs - known_ptrs' assms(2) assms(7) type_wf' - by blast + known_ptrs' assms(2) assms(7) type_wf' + by blast then obtain ancestors' where ancestors': "h' \ get_ancestors ptr \\<^sub>r ancestors'" by auto @@ -1309,8 +1328,8 @@ proof - by(auto simp add: get_root_node_def elim!: bind_returns_result_E2 split: option.splits) qed - have children_eq: - "\p children. p \ ptr \ h \ get_child_nodes p \\<^sub>r children = h' \ get_child_nodes p \\<^sub>r children" + have children_eq: + "\p children. p \ ptr \ h \ get_child_nodes p \\<^sub>r children = h' \ get_child_nodes p \\<^sub>r children" using get_child_nodes_reads assms(3) apply(simp add: reads_def reflp_def transp_def preserved_def) by blast @@ -1319,7 +1338,7 @@ proof - using assms(1) local.parent_child_rel_acyclic by auto have "acyclic (parent_child_rel h')" using assms(2) local.parent_child_rel_acyclic by blast - have 2: "\c parent_opt. cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c \ set ancestors \ set ancestors' + have 2: "\c parent_opt. cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c \ set ancestors \ set ancestors' \ h \ get_parent c \\<^sub>r parent_opt = h' \ get_parent c \\<^sub>r parent_opt" proof - fix c parent_opt @@ -1337,47 +1356,47 @@ proof - proof (cases "p = ptr") case True have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*" - using get_ancestors_parent_child_rel 1 assms by blast + using get_ancestors_parent_child_rel 1 assms by blast then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)" proof (cases "cast c = ptr") case True - then show ?thesis + then show ?thesis using \acyclic (parent_child_rel h)\ by(auto simp add: acyclic_def) next case False then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)\<^sup>*" - using \acyclic (parent_child_rel h)\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl - \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*\ + using \acyclic (parent_child_rel h)\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl + \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h)\<^sup>*\ by (metis acyclic_def) then show ?thesis using r_into_rtrancl by auto qed obtain children where children: "h \ get_child_nodes ptr \\<^sub>r children" - using type_wf - by (metis \h' \ ok get_ancestors ptr\ assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok - heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr - object_ptr_kinds_eq3) + using type_wf + by (metis \h' \ ok get_ancestors ptr\ assms(1) get_ancestors_ptr_in_heap get_child_nodes_ok + heap_is_wellformed_def is_OK_returns_result_E known_ptrs local.known_ptrs_known_ptr + object_ptr_kinds_eq3) then have "c \ set children" using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h)\ assms(1) using parent_child_rel_child_nodes2 using child_parent_dual known_ptrs parent_child_rel_parent - type_wf by blast + type_wf by blast with children have "h \ ?P p \\<^sub>r False" by(auto simp add: True) moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*" - using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf - type_wf' by blast + using get_ancestors_parent_child_rel assms(2) ancestors' 1 known_ptrs' type_wf + type_wf' by blast then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')" proof (cases "cast c = ptr") case True - then show ?thesis + then show ?thesis using \acyclic (parent_child_rel h')\ by(auto simp add: acyclic_def) next case False then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\<^sup>*" using \acyclic (parent_child_rel h')\ False rtrancl_eq_or_trancl rtrancl_trancl_trancl - \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*\ + \(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c, ptr) \ (parent_child_rel h')\<^sup>*\ by (metis acyclic_def) then show ?thesis using r_into_rtrancl by auto @@ -1385,12 +1404,12 @@ proof - then have "(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')" using r_into_rtrancl by auto obtain children' where children': "h' \ get_child_nodes ptr \\<^sub>r children'" - using type_wf type_wf' - by (meson \h' \ ok (get_ancestors ptr)\ assms(2) get_ancestors_ptr_in_heap - get_child_nodes_ok is_OK_returns_result_E known_ptrs' - local.known_ptrs_known_ptr) + using type_wf type_wf' + by (meson \h' \ ok (get_ancestors ptr)\ assms(2) get_ancestors_ptr_in_heap + get_child_nodes_ok is_OK_returns_result_E known_ptrs' + local.known_ptrs_known_ptr) then have "c \ set children'" - using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\ assms(2) type_wf type_wf' + using \(ptr, cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \ (parent_child_rel h')\ assms(2) type_wf type_wf' using parent_child_rel_child_nodes2 child_parent_dual known_ptrs' parent_child_rel_parent by auto with children' have "h' \ ?P p \\<^sub>r False" @@ -1402,76 +1421,76 @@ proof - case False then show ?thesis using children_eq ptrs - by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E - get_child_nodes_pure return_returns_result) + by (metis (no_types, lifting) bind_pure_returns_result_I bind_returns_result_E + get_child_nodes_pure return_returns_result) qed qed - have "\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + have "\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf type_wf' - by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I - get_child_nodes_ok get_child_nodes_pure known_ptrs' - local.known_ptrs_known_ptr return_ok select_result_I2) - have children_eq_False: - "\pa. pa \ set ptrs \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r False = h' \ get_child_nodes pa + using assms(1) assms(2) object_ptr_kinds_eq ptrs type_wf type_wf' + by (metis (no_types, lifting) ObjectMonad.ptr_kinds_ptr_kinds_M bind_is_OK_pure_I + get_child_nodes_ok get_child_nodes_pure known_ptrs' + local.known_ptrs_known_ptr return_ok select_result_I2) + have children_eq_False: + "\pa. pa \ set ptrs \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r False = h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" proof fix pa - assume "pa \ set ptrs" - and "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - have "h \ ok (get_child_nodes pa \ (\children. return (c \ set children))) + assume "pa \ set ptrs" + and "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" + have "h \ ok (get_child_nodes pa \ (\children. return (c \ set children))) \ h' \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using \pa \ set ptrs\ \\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa - \ (\children. return (c \ set children)))\ + using \pa \ set ptrs\ \\pa. pa \ set ptrs \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + \ (\children. return (c \ set children)))\ by auto - moreover have "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False + moreover have "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False \ h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - by (metis (mono_tags, lifting) \\pa. pa \ set ptrs - \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ - calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) + by (metis (mono_tags, lifting) \\pa. pa \ set ptrs + \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ + calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) ultimately show "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" using \h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False\ by auto next fix pa - assume "pa \ set ptrs" + assume "pa \ set ptrs" and "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - have "h' \ ok (get_child_nodes pa \ (\children. return (c \ set children))) + have "h' \ ok (get_child_nodes pa \ (\children. return (c \ set children))) \ h \ ok ( get_child_nodes pa \ (\children. return (c \ set children)))" - using \pa \ set ptrs\ \\pa. pa \ set ptrs - \ h \ ok (get_child_nodes pa - \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa - \ (\children. return (c \ set children)))\ + using \pa \ set ptrs\ \\pa. pa \ set ptrs + \ h \ ok (get_child_nodes pa + \ (\children. return (c \ set children))) = h' \ ok ( get_child_nodes pa + \ (\children. return (c \ set children)))\ by auto - moreover have "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False + moreover have "h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False \ h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" - by (metis (mono_tags, lifting) - \\pa. pa \ set ptrs \ h \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa - \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ - calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) + by (metis (mono_tags, lifting) + \\pa. pa \ set ptrs \ h \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True = h' \ get_child_nodes pa + \ (\children. return (c \ set children)) \\<^sub>r True\ \pa \ set ptrs\ + calculation is_OK_returns_result_I returns_result_eq returns_result_select_result) ultimately show "h \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False" using \h' \ get_child_nodes pa \ (\children. return (c \ set children)) \\<^sub>r False\ by blast qed have filter_eq: "\xs. h \ filter_M ?P ptrs \\<^sub>r xs = h' \ filter_M ?P ptrs \\<^sub>r xs" proof (rule filter_M_eq) - show - "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h" + show + "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h" by(auto intro!: bind_pure_I) next - show - "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h'" + show + "\xs x. pure (Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children))) h'" by(auto intro!: bind_pure_I) next fix xs b x assume 0: "x \ set ptrs" - then show "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b + then show "h \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b = h' \ Heap_Error_Monad.bind (get_child_nodes x) (\children. return (c \ set children)) \\<^sub>r b" apply(induct b) using children_eq_True apply blast @@ -1498,15 +1517,15 @@ proof - qed have "ancestors = ancestors'" - proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors' - rule: heap_wellformed_induct_rev) + proof(insert assms(1) assms(7) ancestors' 2, induct ptr arbitrary: ancestors ancestors' + rule: heap_wellformed_induct_rev) case (step child) show ?case using step(2) step(3) step(4) apply(simp add: get_ancestors_def) apply(auto intro!: elim!: bind_returns_result_E2 split: option.splits)[1] using returns_result_eq apply fastforce - apply (meson option.simps(3) returns_result_eq) + apply (meson option.simps(3) returns_result_eq) by (metis IntD1 IntD2 option.inject returns_result_eq step.hyps) qed then show ?thesis @@ -1519,7 +1538,7 @@ lemma get_ancestors_remains_not_in_ancestors: and "heap_is_wellformed h'" and "h \ get_ancestors ptr \\<^sub>r ancestors" and "h' \ get_ancestors ptr \\<^sub>r ancestors'" - and "\p children children'. h \ get_child_nodes p \\<^sub>r children + and "\p children children'. h \ get_child_nodes p \\<^sub>r children \ h' \ get_child_nodes p \\<^sub>r children' \ set children' \ set children" and "node \ set ancestors" and object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" @@ -1528,7 +1547,7 @@ lemma get_ancestors_remains_not_in_ancestors: and type_wf': "type_wf h'" shows "node \ set ancestors'" proof - - have object_ptr_kinds_M_eq: + have object_ptr_kinds_M_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" using object_ptr_kinds_eq3 by(simp add: object_ptr_kinds_M_defs) @@ -1536,8 +1555,8 @@ proof - by(simp) show ?thesis - proof (insert assms(1) assms(3) assms(4) assms(6), induct ptr arbitrary: ancestors ancestors' - rule: heap_wellformed_induct_rev) + proof (insert assms(1) assms(3) assms(4) assms(6), induct ptr arbitrary: ancestors ancestors' + rule: heap_wellformed_induct_rev) case (step child) have 1: "\p parent. h' \ get_parent p \\<^sub>r Some parent \ h \ get_parent p \\<^sub>r Some parent" proof - @@ -1548,11 +1567,11 @@ proof - p_in_children': "p \ set children'" using get_parent_child_dual by blast obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" - using get_child_nodes_ok assms(1) get_child_nodes_ptr_in_heap object_ptr_kinds_eq children' - known_ptrs + using get_child_nodes_ok assms(1) get_child_nodes_ptr_in_heap object_ptr_kinds_eq children' + known_ptrs using type_wf type_wf' - by (metis \h' \ get_parent p \\<^sub>r Some parent\ get_parent_parent_in_heap is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis \h' \ get_parent p \\<^sub>r Some parent\ get_parent_parent_in_heap is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) have "p \ set children" using assms(5) children children' p_in_children' by blast @@ -1560,13 +1579,13 @@ proof - using child_parent_dual assms(1) children known_ptrs type_wf by blast qed have "node \ child" - using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs + using assms(1) get_ancestors_parent_child_rel step.prems(1) step.prems(3) known_ptrs using type_wf type_wf' by blast then show ?case using step(2) step(3) apply(simp add: get_ancestors_def) - using step(4) + using step(4) apply(auto elim!: bind_returns_result_E2 split: option.splits)[1] using 1 apply (meson option.distinct(1) returns_result_eq) @@ -1591,8 +1610,8 @@ next by(auto simp add: get_ancestors_def[of x] elim!: bind_returns_result_E2 split: option.splits) then show ?case using Cons.hyps Cons.prems(2) get_ancestors_ptr_in_heap x - by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap - is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) get_ancestors_obtains_children get_child_nodes_ptr_in_heap + is_OK_returns_result_I) qed @@ -1602,26 +1621,26 @@ lemma get_ancestors_prefix: assumes "ptr' \ set ancestors" assumes "h \ get_ancestors ptr' \\<^sub>r ancestors'" shows "\pre. ancestors = pre @ ancestors'" -proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors' - rule: heap_wellformed_induct) +proof (insert assms(1) assms(5) assms(6), induct ptr' arbitrary: ancestors' + rule: heap_wellformed_induct) case (step parent) then show ?case proof (cases "parent \ ptr" ) case True - then obtain children ancestor_child where "h \ get_child_nodes parent \\<^sub>r children" - and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" - using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast - then have "h \ get_parent ancestor_child \\<^sub>r Some parent" - using assms(1) assms(2) assms(3) child_parent_dual by blast - then have "h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'" - apply(simp add: get_ancestors_def) - using \h \ get_ancestors parent \\<^sub>r ancestors'\ get_parent_ptr_in_heap - by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I) - then show ?thesis - using step(1) \h \ get_child_nodes parent \\<^sub>r children\ \ancestor_child \ set children\ - \cast ancestor_child \ set ancestors\ \h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'\ - by fastforce + then obtain children ancestor_child where "h \ get_child_nodes parent \\<^sub>r children" + and "ancestor_child \ set children" and "cast ancestor_child \ set ancestors" + using assms(1) assms(2) assms(3) assms(4) get_ancestors_obtains_children step.prems(1) by blast + then have "h \ get_parent ancestor_child \\<^sub>r Some parent" + using assms(1) assms(2) assms(3) child_parent_dual by blast + then have "h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'" + apply(simp add: get_ancestors_def) + using \h \ get_ancestors parent \\<^sub>r ancestors'\ get_parent_ptr_in_heap + by(auto simp add: check_in_heap_def is_OK_returns_result_I intro!: bind_pure_returns_result_I) + then show ?thesis + using step(1) \h \ get_child_nodes parent \\<^sub>r children\ \ancestor_child \ set children\ + \cast ancestor_child \ set ancestors\ \h \ get_ancestors (cast ancestor_child) \\<^sub>r cast ancestor_child # ancestors'\ + by fastforce next case False then show ?thesis @@ -1638,25 +1657,25 @@ lemma get_ancestors_same_root_node: shows "h \ get_root_node ptr' \\<^sub>r root_ptr \ h \ get_root_node ptr'' \\<^sub>r root_ptr" proof - have "ptr' |\| object_ptr_kinds h" - by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children - get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_obtains_children + get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) then obtain ancestors' where ancestors': "h \ get_ancestors ptr' \\<^sub>r ancestors'" by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E) then have "\pre. ancestors = pre @ ancestors'" using get_ancestors_prefix assms by blast moreover have "ptr'' |\| object_ptr_kinds h" - by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children - get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) + by (metis assms(1) assms(2) assms(3) assms(4) assms(6) get_ancestors_obtains_children + get_ancestors_ptr_in_heap get_child_nodes_ptr_in_heap is_OK_returns_result_I) then obtain ancestors'' where ancestors'': "h \ get_ancestors ptr'' \\<^sub>r ancestors''" by (meson assms(1) assms(2) assms(3) get_ancestors_ok is_OK_returns_result_E) then have "\pre. ancestors = pre @ ancestors''" using get_ancestors_prefix assms by blast ultimately show ?thesis using ancestors' ancestors'' - apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2 + apply(auto simp add: get_root_node_def elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)[1] - apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR - returns_result_eq) + apply (metis (no_types, lifting) assms(1) get_ancestors_never_empty last_appendR + returns_result_eq) by (metis assms(1) get_ancestors_never_empty last_appendR returns_result_eq) qed @@ -1668,7 +1687,7 @@ proof show "h \ get_root_node ptr \\<^sub>r root" using 1[unfolded get_root_node_def] assms apply(simp add: get_ancestors_def) - apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I split: option.splits)[1] using returns_result_eq apply fastforce using get_ancestors_ptr by fastforce @@ -1678,8 +1697,8 @@ next apply(simp add: get_root_node_def) using assms 1 apply(simp add: get_ancestors_def) - apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I split: option.splits)[1] + apply(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I split: option.splits)[1] apply (simp add: check_in_heap_def is_OK_returns_result_I) using get_ancestors_ptr get_parent_ptr_in_heap apply (simp add: is_OK_returns_result_I) @@ -1704,9 +1723,9 @@ proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev) case (Some child_node) note s = this then obtain parent_opt where parent_opt: "h \ get_parent child_node \\<^sub>r parent_opt" - by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap - is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute - node_ptr_kinds_commutes returns_result_select_result step.prems) + by (metis (no_types, lifting) assms(2) assms(3) get_root_node_ptr_in_heap + is_OK_returns_result_I local.get_parent_ok node_ptr_casts_commute + node_ptr_kinds_commutes returns_result_select_result step.prems) then show ?thesis proof(induct parent_opt) case None @@ -1716,8 +1735,8 @@ proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev) case (Some parent) then show ?case using step s - apply(auto simp add: get_root_node_def get_ancestors_def[of c] - elim!: bind_returns_result_E2 split: option.splits list.splits)[1] + apply(auto simp add: get_root_node_def get_ancestors_def[of c] + elim!: bind_returns_result_E2 split: option.splits list.splits)[1] using get_root_node_parent_same step.hyps step.prems by auto qed qed @@ -1729,8 +1748,8 @@ lemma get_root_node_not_node_same: shows "h \ get_root_node ptr \\<^sub>r ptr" using assms apply(simp add: get_root_node_def get_ancestors_def) - by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 - intro!: bind_pure_returns_result_I split: option.splits) + by(auto simp add: get_root_node_def dest: returns_result_eq elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I split: option.splits) lemma get_root_node_root_in_heap: @@ -1746,86 +1765,86 @@ lemma get_root_node_same_no_parent_parent_child_rel: assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h" assumes "h \ get_root_node ptr' \\<^sub>r ptr'" shows "\(\p. (p, ptr') \ (parent_child_rel h))" - by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent - l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok - local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr - local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) assms(1) assms(2) assms(3) assms(4) get_root_node_same_no_parent + l_heap_is_wellformed.parent_child_rel_child local.child_parent_dual local.get_child_nodes_ok + local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms local.parent_child_rel_node_ptr + local.parent_child_rel_parent_in_heap node_ptr_casts_commute3 option.simps(3) returns_result_eq + returns_result_select_result) end -locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs - + l_get_child_nodes_defs + l_get_parent_defs + +locale l_get_ancestors_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_ancestors_defs + + l_get_child_nodes_defs + l_get_parent_defs + assumes get_ancestors_never_empty: "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ ancestors \ []" assumes get_ancestors_ok: - "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h + "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h \ h \ ok (get_ancestors ptr)" assumes get_ancestors_reads: "heap_is_wellformed h \ reads get_ancestors_locs (get_ancestors node_ptr) h h'" - assumes get_ancestors_ptrs_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors + assumes get_ancestors_ptrs_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors \ ptr' |\| object_ptr_kinds h" assumes get_ancestors_remains_not_in_ancestors: - "heap_is_wellformed h \ heap_is_wellformed h' \ h \ get_ancestors ptr \\<^sub>r ancestors - \ h' \ get_ancestors ptr \\<^sub>r ancestors' - \ (\p children children'. h \ get_child_nodes p \\<^sub>r children - \ h' \ get_child_nodes p \\<^sub>r children' - \ set children' \ set children) - \ node \ set ancestors - \ object_ptr_kinds h = object_ptr_kinds h' \ known_ptrs h + "heap_is_wellformed h \ heap_is_wellformed h' \ h \ get_ancestors ptr \\<^sub>r ancestors + \ h' \ get_ancestors ptr \\<^sub>r ancestors' + \ (\p children children'. h \ get_child_nodes p \\<^sub>r children + \ h' \ get_child_nodes p \\<^sub>r children' + \ set children' \ set children) + \ node \ set ancestors + \ object_ptr_kinds h = object_ptr_kinds h' \ known_ptrs h \ type_wf h \ type_wf h' \ node \ set ancestors'" assumes get_ancestors_also_parent: - "heap_is_wellformed h \ h \ get_ancestors some_ptr \\<^sub>r ancestors - \ cast child_node \ set ancestors - \ h \ get_parent child_node \\<^sub>r Some parent \ type_wf h + "heap_is_wellformed h \ h \ get_ancestors some_ptr \\<^sub>r ancestors + \ cast child_node \ set ancestors + \ h \ get_parent child_node \\<^sub>r Some parent \ type_wf h \ known_ptrs h \ parent \ set ancestors" assumes get_ancestors_obtains_children: - "heap_is_wellformed h \ ancestor \ ptr \ ancestor \ set ancestors - \ h \ get_ancestors ptr \\<^sub>r ancestors \ type_wf h \ known_ptrs h - \ (\children ancestor_child . h \ get_child_nodes ancestor \\<^sub>r children - \ ancestor_child \ set children - \ cast ancestor_child \ set ancestors - \ thesis) + "heap_is_wellformed h \ ancestor \ ptr \ ancestor \ set ancestors + \ h \ get_ancestors ptr \\<^sub>r ancestors \ type_wf h \ known_ptrs h + \ (\children ancestor_child . h \ get_child_nodes ancestor \\<^sub>r children + \ ancestor_child \ set children + \ cast ancestor_child \ set ancestors + \ thesis) \ thesis" assumes get_ancestors_parent_child_rel: - "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ known_ptrs h \ type_wf h + "heap_is_wellformed h \ h \ get_ancestors child \\<^sub>r ancestors \ known_ptrs h \ type_wf h \ (ptr, child) \ (parent_child_rel h)\<^sup>* \ ptr \ set ancestors" -locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf - + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs + - assumes get_root_node_ok: - "heap_is_wellformed h \ known_ptrs h \ type_wf h \ ptr |\| object_ptr_kinds h +locale l_get_root_node_wf = l_heap_is_wellformed_defs + l_get_root_node_defs + l_type_wf + + l_known_ptrs + l_get_ancestors_defs + l_get_parent_defs + + assumes get_root_node_ok: + "heap_is_wellformed h \ known_ptrs h \ type_wf h \ ptr |\| object_ptr_kinds h \ h \ ok (get_root_node ptr)" - assumes get_root_node_ptr_in_heap: + assumes get_root_node_ptr_in_heap: "h \ ok (get_root_node ptr) \ ptr |\| object_ptr_kinds h" - assumes get_root_node_root_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h + assumes get_root_node_root_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_root_node ptr \\<^sub>r root \ root |\| object_ptr_kinds h" - assumes get_ancestors_same_root_node: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors - \ ptr'' \ set ancestors + assumes get_ancestors_same_root_node: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_ancestors ptr \\<^sub>r ancestors \ ptr' \ set ancestors + \ ptr'' \ set ancestors \ h \ get_root_node ptr' \\<^sub>r root_ptr \ h \ get_root_node ptr'' \\<^sub>r root_ptr" - assumes get_root_node_same_no_parent: - "heap_is_wellformed h \ type_wf h \ known_ptrs h + 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_parent_same: - "h \ get_parent child \\<^sub>r Some 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" interpretation i_get_root_node_wf?: - l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel - get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel + get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs using instances by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]: - "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors + "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors get_ancestors_locs get_child_nodes get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def)[1] @@ -1841,7 +1860,7 @@ lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]: done lemma get_root_node_wf_is_l_get_root_node_wf [instances]: - "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs + "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs get_ancestors get_parent" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def)[1] @@ -1856,7 +1875,7 @@ lemma get_root_node_wf_is_l_get_root_node_wf [instances]: subsection \to\_tree\_order\ -locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = +locale l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_get_parent + l_get_parent_wf + @@ -1880,7 +1899,7 @@ lemma to_tree_order_either_ptr_or_in_children: and "node \ set nodes" and "h \ get_child_nodes ptr \\<^sub>r children" and "node \ ptr" - obtains child child_to where "child \ set children" + obtains child child_to where "child \ set children" and "h \ to_tree_order (cast child) \\<^sub>r child_to" and "node \ set child_to" proof - obtain treeorders where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" @@ -1890,11 +1909,11 @@ proof - then have "node \ set (concat treeorders)" using assms[simplified to_tree_order_def] by(auto elim!: bind_returns_result_E4 dest: pure_returns_heap_eq) - then obtain treeorder where "treeorder \ set treeorders" - and node_in_treeorder: "node \ set treeorder" + then obtain treeorder where "treeorder \ set treeorders" + and node_in_treeorder: "node \ set treeorder" by auto - then obtain child where "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r treeorder" - and "child \ set children" + then obtain child where "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r treeorder" + and "child \ set children" using assms[simplified to_tree_order_def] treeorders by(auto elim!: map_M_pure_E2) then show ?thesis @@ -1911,7 +1930,7 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel case (step parent) have "parent |\| object_ptr_kinds h" using assms(1) assms(2) assms(3) step.prems(1) to_tree_order_ptr_in_heap by blast - then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" + then obtain children where children: "h \ get_child_nodes parent \\<^sub>r children" by (meson assms(2) assms(3) get_child_nodes_ok is_OK_returns_result_E local.known_ptrs_known_ptr) then show ?case proof (cases "children = []") @@ -1920,7 +1939,7 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel using step(2) children apply(auto simp add: to_tree_order_def[of parent] map_M_pure_I elim!: bind_returns_result_E2)[1] by (metis list.distinct(1) list.map_disc_iff list.set_cases map_M_pure_E2 returns_result_eq) - then show ?thesis + then show ?thesis using \parent |\| object_ptr_kinds h\ step.prems(2) by auto next case False @@ -1933,9 +1952,9 @@ proof(insert assms(1) assms(4) assms(5), induct ptr arbitrary: to rule: heap_wel using \parent |\| object_ptr_kinds h\ by blast next case False - then show ?thesis - using children step.hyps to_tree_order_either_ptr_or_in_children - by (metis step.prems(1) step.prems(2)) + then show ?thesis + using children step.hyps to_tree_order_either_ptr_or_in_children + by (metis step.prems(1) step.prems(2)) qed qed qed @@ -1958,16 +1977,16 @@ qed lemma to_tree_order_child_subset: assumes "heap_is_wellformed h" - and "h \ to_tree_order ptr \\<^sub>r nodes" - and "h \ get_child_nodes ptr \\<^sub>r children" - and "node \ set children" - and "h \ to_tree_order (cast node) \\<^sub>r nodes'" - shows "set nodes' \ set nodes" + and "h \ to_tree_order ptr \\<^sub>r nodes" + and "h \ get_child_nodes ptr \\<^sub>r children" + and "node \ set children" + and "h \ to_tree_order (cast node) \\<^sub>r nodes'" + shows "set nodes' \ set nodes" proof fix x assume a1: "x \ set nodes'" - moreover obtain treeorders - where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" + moreover obtain treeorders + where treeorders: "h \ map_M to_tree_order (map cast children) \\<^sub>r treeorders" using assms(2) assms(3) apply(auto simp add: to_tree_order_def elim!: bind_returns_result_E)[1] using pure_returns_heap_eq returns_result_eq by fastforce @@ -1997,7 +2016,7 @@ lemma to_tree_order_subset: and type_wf: "type_wf h" shows "set nodes' \ set nodes" proof - - have "\nodes. h \ to_tree_order ptr \\<^sub>r nodes \ (\node. node \ set nodes + have "\nodes. h \ to_tree_order ptr \\<^sub>r nodes \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes))" proof(insert assms(1), induct ptr rule: heap_wellformed_induct) case (step parent) @@ -2006,8 +2025,8 @@ proof - fix nodes node nodes' x assume 1: "(\children child. h \ get_child_nodes parent \\<^sub>r children \ - child \ set children \ \nodes. h \ to_tree_order (cast child) \\<^sub>r nodes - \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' + child \ set children \ \nodes. h \ to_tree_order (cast child) \\<^sub>r nodes + \ (\node. node \ set nodes \ (\nodes'. h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes)))" and 2: "h \ to_tree_order parent \\<^sub>r nodes" and 3: "node \ set nodes" @@ -2015,7 +2034,7 @@ proof - and "x \ set nodes'" have h1: "(\children child nodes node nodes'. h \ get_child_nodes parent \\<^sub>r children \ - child \ set children \ h \ to_tree_order (cast child) \\<^sub>r nodes + child \ set children \ h \ to_tree_order (cast child) \\<^sub>r nodes \ (node \ set nodes \ (h \ to_tree_order node \\<^sub>r nodes' \ set nodes' \ set nodes)))" using 1 by blast @@ -2026,8 +2045,8 @@ proof - proof (cases "children = []") case True then show ?thesis - by (metis "2" "3" \h \ to_tree_order node \\<^sub>r nodes'\ children empty_iff list.set(1) - subsetI to_tree_order_either_ptr_or_in_children) + by (metis "2" "3" \h \ to_tree_order node \\<^sub>r nodes'\ children empty_iff list.set(1) + subsetI to_tree_order_either_ptr_or_in_children) next case False then show ?thesis @@ -2041,8 +2060,8 @@ proof - "child \ set children" and "h \ to_tree_order (cast child) \\<^sub>r nodes_of_child" and "node \ set nodes_of_child" - using 2[simplified to_tree_order_def] 3 - to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children + using 2[simplified to_tree_order_def] 3 + to_tree_order_either_ptr_or_in_children[where node=node and ptr=parent] children apply(auto elim!: bind_returns_result_E2 intro: map_M_pure_I)[1] using is_OK_returns_result_E 2 a_all_ptrs_in_heap_def assms(1) heap_is_wellformed_def using "3" by blast @@ -2050,8 +2069,8 @@ proof - using h1 using \h \ to_tree_order node \\<^sub>r nodes'\ children by blast moreover have "set nodes_of_child \ set nodes" - using "2" \child \ set children\ \h \ to_tree_order (cast child) \\<^sub>r nodes_of_child\ - assms children to_tree_order_child_subset by auto + using "2" \child \ set children\ \h \ to_tree_order (cast child) \\<^sub>r nodes_of_child\ + assms children to_tree_order_child_subset by auto ultimately show ?thesis by blast qed @@ -2083,18 +2102,18 @@ proof - child: "child \ set children" using assms get_parent_child_dual by blast then obtain child_to where child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r child_to" - by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I - get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok) + by (meson assms(1) assms(2) assms(3) assms(5) is_OK_returns_result_E is_OK_returns_result_I + get_parent_ptr_in_heap node_ptr_kinds_commutes to_tree_order_ok) then have "cast child \ set child_to" apply(simp add: to_tree_order_def) - by(auto elim!: bind_returns_result_E2 map_M_pure_E - dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I) - + by(auto elim!: bind_returns_result_E2 map_M_pure_E + dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I) + have "cast child \ set nodes'" using nodes' child apply(simp add: to_tree_order_def) - apply(auto elim!: bind_returns_result_E2 map_M_pure_E - dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I)[1] + apply(auto elim!: bind_returns_result_E2 map_M_pure_E + dest!: bind_returns_result_E3[rotated, OF children, rotated] intro!: map_M_pure_I)[1] using child_to \cast child \ set child_to\ returns_result_eq by fastforce ultimately show ?thesis by auto @@ -2107,9 +2126,9 @@ lemma to_tree_order_child: assumes "cast child \ ptr" assumes "child \ set children" assumes "cast child \ set nodes" -shows "parent \ set nodes" -proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes - rule: heap_wellformed_induct) + shows "parent \ set nodes" +proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2121,22 +2140,22 @@ proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated]) + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated]) next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "cast child \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] by (metis (full_types) assms(1) assms(2) assms(3) get_parent_ptr_in_heap - is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual - l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes - returns_result_select_result step.prems(1) step.prems(2) step.prems(3) - to_tree_order_either_ptr_or_in_children to_tree_order_ok) + is_OK_returns_result_I l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual + l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_kinds_commutes + returns_result_select_result step.prems(1) step.prems(2) step.prems(3) + to_tree_order_either_ptr_or_in_children to_tree_order_ok) then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2146,16 +2165,16 @@ proof(insert assms(1) assms(4) assms(6) assms(8), induct ptr arbitrary: nodes then have "parent = p" using step(3) children child assms(5) assms(7) by (meson assms(1) assms(2) assms(3) child_parent_dual option.inject returns_result_eq) - + then show ?thesis using step.prems(1) to_tree_order_ptr_in_result by blast next case False - then show ?thesis - using step(1)[OF children child child_to] step(3) step(4) - using \set child_to \ set nodes\ - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ by auto - qed + then show ?thesis + using step(1)[OF children child child_to] step(3) step(4) + using \set child_to \ set nodes\ + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ by auto + qed qed qed @@ -2165,8 +2184,8 @@ lemma to_tree_order_node_ptrs: assumes "ptr' \ ptr" assumes "ptr' \ set nodes" shows "is_node_ptr_kind ptr'" -proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes - rule: heap_wellformed_induct) +proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2178,18 +2197,18 @@ proof(insert assms(1) assms(4) assms(5) assms(6), induct ptr arbitrary: nodes case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "ptr' \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] - using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2216,7 +2235,7 @@ proof - assume 1: "(\parent. h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes \ thesis)" show thesis proof(insert assms(1) assms(4) assms(5) assms(6) 1, induct ptr arbitrary: nodes - rule: heap_wellformed_induct) + rule: heap_wellformed_induct) case (step p) have "p |\| object_ptr_kinds h" using \h \ to_tree_order p \\<^sub>r nodes\ to_tree_order_ptr_in_heap @@ -2228,18 +2247,18 @@ proof - case True then show ?thesis using step(2) step(3) step(4) children - by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated]) + by(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated]) next case False then obtain c child_to where child: "c \ set children" and child_to: "h \ to_tree_order (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r c) \\<^sub>r child_to" and "cast child \ set child_to" - using step(2) children - apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 - dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] - using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children + using step(2) children + apply(auto simp add: to_tree_order_def[of p] map_M_pure_I elim!: bind_returns_result_E2 + dest!: bind_returns_result_E3[rotated, OF children, rotated])[1] + using step.prems(1) step.prems(2) step.prems(3) to_tree_order_either_ptr_or_in_children by blast then have "set child_to \ set nodes" using assms(1) child children step.prems(1) to_tree_order_child_subset by auto @@ -2252,14 +2271,14 @@ proof - proof (induct parent_opt) case None then show ?case - by (metis \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ assms(1) assms(2) assms(3) - cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject child child_parent_dual child_to children - option.distinct(1) returns_result_eq step.hyps) + by (metis \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \ set child_to\ assms(1) assms(2) assms(3) + cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject child child_parent_dual child_to children + option.distinct(1) returns_result_eq step.hyps) next case (Some option) - then show ?case - by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2) - step.prems(3) step.prems(4) to_tree_order_child) + then show ?case + by (meson assms(1) assms(2) assms(3) get_parent_child_dual step.prems(1) step.prems(2) + step.prems(3) step.prems(4) to_tree_order_child) qed qed qed @@ -2289,15 +2308,15 @@ proof using \ptr \ child\ by (metis "1.prems" rtranclE) obtain child_node where child_node: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child" - using \(child_parent, child) \ parent_child_rel h\ node_ptr_casts_commute3 - parent_child_rel_node_ptr + using \(child_parent, child) \ parent_child_rel h\ node_ptr_casts_commute3 + parent_child_rel_node_ptr by blast then have "h \ get_parent child_node \\<^sub>r Some child_parent" using \(child_parent, child) \ (parent_child_rel h)\ - by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual - l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok - local.known_ptrs_known_ptr local.l_get_parent_wf_axioms - local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap) + by (meson assms(1) assms(2) assms(3) is_OK_returns_result_E l_get_parent_wf.child_parent_dual + l_heap_is_wellformed.parent_child_rel_child local.get_child_nodes_ok + local.known_ptrs_known_ptr local.l_get_parent_wf_axioms + local.l_heap_is_wellformed_axioms local.parent_child_rel_parent_in_heap) then show ?thesis using 1(1) child_node \(ptr, child_parent) \ (parent_child_rel h)\<^sup>*\ using assms(1) assms(2) assms(3) assms(4) to_tree_order_parent by blast @@ -2316,8 +2335,8 @@ next next case False then have "\parent. (parent, child) \ (parent_child_rel h)" - using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)] - to_tree_order_node_ptrs + using 1(2) assms(4) to_tree_order_child2[OF assms(1) assms(2) assms(3) assms(4)] + to_tree_order_node_ptrs by (metis assms(1) assms(2) assms(3) node_ptr_casts_commute3 parent_child_rel_parent) then obtain child_node where child_node: "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child" using node_ptr_casts_commute3 parent_child_rel_node_ptr by blast @@ -2327,8 +2346,8 @@ next then have "(child_parent, child) \ (parent_child_rel h)" using assms(1) child_node parent_child_rel_parent by blast moreover have "child_parent \ set to" - by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent - get_parent_child_dual to_tree_order_child) + by (metis "1.prems" False assms(1) assms(2) assms(3) assms(4) child_node child_parent + get_parent_child_dual to_tree_order_child) then have "(ptr, child_parent) \ (parent_child_rel h)\<^sup>*" using 1 child_node child_parent by blast ultimately show ?thesis @@ -2338,60 +2357,60 @@ next qed end -interpretation i_to_tree_order_wf?: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs to_tree_order known_ptrs get_parent - get_parent_locs heap_is_wellformed parent_child_rel - get_disconnected_nodes get_disconnected_nodes_locs +interpretation i_to_tree_order_wf?: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs to_tree_order known_ptrs get_parent + get_parent_locs heap_is_wellformed parent_child_rel + get_disconnected_nodes get_disconnected_nodes_locs using instances apply(simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) done declare l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs - + l_to_tree_order_defs - + l_get_parent_defs + l_get_child_nodes_defs + - assumes to_tree_order_ok: - "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h +locale l_to_tree_order_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_to_tree_order_defs + + l_get_parent_defs + l_get_child_nodes_defs + + assumes to_tree_order_ok: + "heap_is_wellformed h \ ptr |\| object_ptr_kinds h \ known_ptrs h \ type_wf h \ h \ ok (to_tree_order ptr)" - assumes to_tree_order_ptrs_in_heap: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + assumes to_tree_order_ptrs_in_heap: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to \ ptr' \ set to \ ptr' |\| object_ptr_kinds h" assumes to_tree_order_parent_child_rel: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to \ (ptr, child_ptr) \ (parent_child_rel h)\<^sup>* \ child_ptr \ set to" - assumes to_tree_order_child2: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ cast child \ ptr \ cast child \ set nodes - \ (\parent. h \ get_parent child \\<^sub>r Some parent - \ parent \ set nodes \ thesis) + assumes to_tree_order_child2: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ cast child \ ptr \ cast child \ set nodes + \ (\parent. h \ get_parent child \\<^sub>r Some parent + \ parent \ set nodes \ thesis) \ thesis" - assumes to_tree_order_node_ptrs: + assumes to_tree_order_node_ptrs: "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes \ ptr' \ ptr \ ptr' \ set nodes \ is_node_ptr_kind ptr'" - assumes to_tree_order_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ h \ get_child_nodes parent \\<^sub>r children \ cast child \ ptr - \ child \ set children \ cast child \ set nodes + assumes to_tree_order_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ h \ get_child_nodes parent \\<^sub>r children \ cast child \ ptr + \ child \ set children \ cast child \ set nodes \ parent \ set nodes" - assumes to_tree_order_ptr_in_result: + assumes to_tree_order_ptr_in_result: "h \ to_tree_order ptr \\<^sub>r nodes \ ptr \ set nodes" - assumes to_tree_order_parent: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes - \ h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes + assumes to_tree_order_parent: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r nodes + \ h \ get_parent child \\<^sub>r Some parent \ parent \ set nodes \ cast child \ set nodes" assumes to_tree_order_subset: - "heap_is_wellformed h \ h \ to_tree_order ptr \\<^sub>r nodes \ node \ set nodes - \ h \ to_tree_order node \\<^sub>r nodes' \ known_ptrs h + "heap_is_wellformed h \ h \ to_tree_order ptr \\<^sub>r nodes \ node \ set nodes + \ h \ to_tree_order node \\<^sub>r nodes' \ known_ptrs h \ type_wf h \ set nodes' \ set nodes" -lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: - "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs +lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: + "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs to_tree_order get_parent get_child_nodes" using instances apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def)[1] - using to_tree_order_ok + using to_tree_order_ok apply blast - using to_tree_order_ptrs_in_heap + using to_tree_order_ptrs_in_heap apply blast using to_tree_order_parent_child_rel apply(blast, blast) @@ -2399,7 +2418,7 @@ lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]: apply blast using to_tree_order_node_ptrs apply blast - using to_tree_order_child + using to_tree_order_child apply blast using to_tree_order_ptr_in_result apply blast @@ -2425,27 +2444,27 @@ lemma to_tree_order_get_root_node: shows "h \ get_root_node ptr'' \\<^sub>r root_ptr" proof - obtain ancestors' where ancestors': "h \ get_ancestors ptr' \\<^sub>r ancestors'" - by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E - to_tree_order_ptrs_in_heap ) + by (meson assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_ok is_OK_returns_result_E + to_tree_order_ptrs_in_heap ) moreover have "ptr \ set ancestors'" using \h \ get_ancestors ptr' \\<^sub>r ancestors'\ - using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel - to_tree_order_parent_child_rel by blast + using assms(1) assms(2) assms(3) assms(4) assms(5) get_ancestors_parent_child_rel + to_tree_order_parent_child_rel by blast ultimately have "h \ get_root_node ptr \\<^sub>r root_ptr" using \h \ get_root_node ptr' \\<^sub>r root_ptr\ using assms(1) assms(2) assms(3) get_ancestors_ptr get_ancestors_same_root_node by blast - + obtain ancestors'' where ancestors'': "h \ get_ancestors ptr'' \\<^sub>r ancestors''" - by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E - to_tree_order_ptrs_in_heap) + by (meson assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_ok is_OK_returns_result_E + to_tree_order_ptrs_in_heap) moreover have "ptr \ set ancestors''" using \h \ get_ancestors ptr'' \\<^sub>r ancestors''\ - using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel - to_tree_order_parent_child_rel by blast + using assms(1) assms(2) assms(3) assms(4) assms(7) get_ancestors_parent_child_rel + to_tree_order_parent_child_rel by blast ultimately show ?thesis - using \h \ get_root_node ptr \\<^sub>r root_ptr\ assms(1) assms(2) assms(3) get_ancestors_ptr - get_ancestors_same_root_node by blast + using \h \ get_root_node ptr \\<^sub>r root_ptr\ assms(1) assms(2) assms(3) get_ancestors_ptr + get_ancestors_same_root_node by blast qed lemma to_tree_order_same_root: @@ -2461,25 +2480,25 @@ proof (insert assms(1)(* assms(4) assms(5) *) assms(6), induct ptr' rule: heap_ case True then have "child = root_ptr" using assms(1) assms(2) assms(3) assms(5) step.prems - by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3 - option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs) + by (metis (no_types, lifting) get_root_node_same_no_parent node_ptr_casts_commute3 + option.simps(3) returns_result_eq to_tree_order_child2 to_tree_order_node_ptrs) then show ?thesis using True by blast next case False - then obtain child_node parent where "cast child_node = child" - and "h \ get_parent child_node \\<^sub>r Some parent" - by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent - local.get_root_node_not_node_same local.get_root_node_same_no_parent - local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3 - step.prems) + then obtain child_node parent where "cast child_node = child" + and "h \ get_parent child_node \\<^sub>r Some parent" + by (metis assms(1) assms(2) assms(3) assms(4) assms(5) local.get_root_node_no_parent + local.get_root_node_not_node_same local.get_root_node_same_no_parent + local.to_tree_order_child2 local.to_tree_order_ptrs_in_heap node_ptr_casts_commute3 + step.prems) then show ?thesis proof (cases "child = root_ptr") case True then have "h \ get_root_node root_ptr \\<^sub>r root_ptr" using assms(4) - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ assms(1) assms(2) assms(3) - get_root_node_no_parent get_root_node_same_no_parent + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ assms(1) assms(2) assms(3) + get_root_node_no_parent get_root_node_same_no_parent by blast then show ?thesis using step assms(4) @@ -2487,41 +2506,43 @@ proof (insert assms(1)(* assms(4) assms(5) *) assms(6), induct ptr' rule: heap_ next case False then have "parent \ set to" - using assms(5) step(2) to_tree_order_child \h \ get_parent child_node \\<^sub>r Some parent\ - \cast child_node = child\ + using assms(5) step(2) to_tree_order_child \h \ get_parent child_node \\<^sub>r Some parent\ + \cast child_node = child\ by (metis False assms(1) assms(2) assms(3) get_parent_child_dual) then show ?thesis - using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ \h \ get_parent child_node \\<^sub>r Some parent\ - get_root_node_parent_same + using \cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child_node = child\ \h \ get_parent child_node \\<^sub>r Some parent\ + get_root_node_parent_same using step.hyps by blast qed - + qed qed end -interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order +interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors + get_ancestors_locs get_root_node get_root_node_locs to_tree_order using instances by(simp add: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) -locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs - + l_get_root_node_defs + l_heap_is_wellformed_defs + - assumes to_tree_order_get_root_node: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to - \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr +locale l_to_tree_order_wf_get_root_node_wf = l_type_wf + l_known_ptrs + l_to_tree_order_defs + + l_get_root_node_defs + l_heap_is_wellformed_defs + + assumes to_tree_order_get_root_node: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ to_tree_order ptr \\<^sub>r to + \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr \ ptr'' \ set to \ h \ get_root_node ptr'' \\<^sub>r root_ptr" - assumes to_tree_order_same_root: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_root_node ptr \\<^sub>r root_ptr - \ h \ to_tree_order root_ptr \\<^sub>r to \ ptr' \ set to + assumes to_tree_order_same_root: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_root_node ptr \\<^sub>r root_ptr + \ h \ to_tree_order root_ptr \\<^sub>r to \ ptr' \ set to \ h \ get_root_node ptr' \\<^sub>r root_ptr" lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [instances]: - "l_to_tree_order_wf_get_root_node_wf type_wf known_ptr known_ptrs to_tree_order + "l_to_tree_order_wf_get_root_node_wf type_wf known_ptr known_ptrs to_tree_order get_root_node heap_is_wellformed" using instances - apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def + apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def l_to_tree_order_wf_get_root_node_wf_axioms_def)[1] using to_tree_order_get_root_node apply blast using to_tree_order_same_root apply blast @@ -2529,7 +2550,7 @@ lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [ 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 @@ -2555,17 +2576,17 @@ proof - by blast have 3: "document_ptr |\| document_ptr_kinds h" using assms(2) get_disconnected_nodes_ptr_in_heap by blast - 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 (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3) - disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent - local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms - returns_result_select_result select_result_I2 type_wf) + have 0: + "\!document_ptr\set |h \ document_ptr_kinds_M|\<^sub>r. node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" + by (metis (no_types, lifting) "3" DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(2) assms(3) + disjoint_iff_not_equal l_heap_is_wellformed.heap_is_wellformed_one_disc_parent + local.get_disconnected_nodes_ok local.l_heap_is_wellformed_axioms + returns_result_select_result select_result_I2 type_wf) have "h \ get_parent node_ptr \\<^sub>r None" using heap_is_wellformed_children_disc_nodes_different child_parent_dual assms - using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok - returns_result_select_result split_option_ex + using "2" disjoint_iff_not_equal local.get_parent_child_dual local.get_parent_ok + returns_result_select_result split_option_ex by (metis (no_types, lifting)) then have 4: "h \ get_root_node (cast node_ptr) \\<^sub>r cast node_ptr" @@ -2573,7 +2594,7 @@ proof - by blast obtain document_ptrs where document_ptrs: "h \ document_ptr_kinds_M \\<^sub>r document_ptrs" by simp - + then have "h \ ok (filter_M (\document_ptr. do { disconnected_nodes \ get_disconnected_nodes document_ptr; @@ -2581,7 +2602,7 @@ proof - }) document_ptrs)" using assms(1) get_disconnected_nodes_ok type_wf unfolding heap_is_wellformed_def by(auto intro!: bind_is_OK_I2 filter_M_is_OK_I bind_pure_I) - then obtain candidates where + then obtain candidates where candidates: "h \ filter_M (\document_ptr. do { disconnected_nodes \ get_disconnected_nodes document_ptr; return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) @@ -2589,13 +2610,13 @@ proof - by auto - have eq: "\document_ptr. document_ptr |\| document_ptr_kinds h + have eq: "\document_ptr. document_ptr |\| document_ptr_kinds h \ node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r \ |h \ do { disconnected_nodes \ get_disconnected_nodes document_ptr; return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) }|\<^sub>r" - apply(auto dest!: get_disconnected_nodes_ok[OF type_wf] - intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1] + apply(auto dest!: get_disconnected_nodes_ok[OF type_wf] + intro!: select_result_I[where P=id, simplified] elim!: bind_returns_result_E2)[1] apply(drule select_result_E[where P=id, simplified]) by(auto elim!: bind_returns_result_E2) @@ -2608,8 +2629,8 @@ proof - using eq using local.get_disconnected_nodes_ok apply auto[1] using assms(2) assms(3) - apply(auto intro!: intro!: select_result_I[where P=id, simplified] - elim!: bind_returns_result_E2)[1] + apply(auto intro!: intro!: select_result_I[where P=id, simplified] + elim!: bind_returns_result_E2)[1] using returns_result_eq apply fastforce using document_ptrs 3 apply(simp) using document_ptrs @@ -2619,22 +2640,22 @@ proof - return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \ cast ` set disconnected_nodes) }) document_ptrs \\<^sub>r [document_ptr]" apply(rule filter_M_filter2) - using get_disconnected_nodes_ok document_ptrs 3 assms(1) type_wf filter + using get_disconnected_nodes_ok document_ptrs 3 assms(1) type_wf filter unfolding heap_is_wellformed_def by(auto intro: bind_pure_I bind_is_OK_I2) with 4 document_ptrs have "h \ a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \\<^sub>r document_ptr" by(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def - intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I - split: option.splits)[1] + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I + split: option.splits)[1] moreover have "known_ptr (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)" using "4" assms(1) known_ptrs type_wf known_ptrs_known_ptr "2" node_ptr_kinds_commutes by blast ultimately show ?thesis using 2 apply(auto simp add: known_ptr_impl get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ - apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) - apply(drule(1) known_ptr_not_character_data_ptr) + apply(drule(1) known_ptr_not_document_ptr[folded known_ptr_impl]) + apply(drule(1) known_ptr_not_character_data_ptr) apply(drule(1) known_ptr_not_element_ptr) apply(simp add: NodeClass.known_ptr_defs) by(auto split: option.splits intro!: bind_pure_returns_result_I) @@ -2657,8 +2678,8 @@ proof - have "\(\parent_ptr. parent_ptr |\| object_ptr_kinds h \ node_ptr \ set |h \ get_child_nodes parent_ptr|\<^sub>r)" apply(auto)[1] using assms(2) child_parent_dual[OF assms(1)] type_wf - assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3) - returns_result_eq returns_result_select_result + assms(1) assms(5) get_child_nodes_ok known_ptrs_known_ptr option.simps(3) + returns_result_eq returns_result_select_result by (metis (no_types, hide_lams)) moreover have "node_ptr |\| node_ptr_kinds h" using assms(2) get_parent_ptr_in_heap by blast @@ -2671,12 +2692,12 @@ proof - by auto then show ?thesis using get_owner_document_disconnected_nodes known_ptrs type_wf assms - using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok - returns_result_select_result select_result_I2 + using DocumentMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) assms(4) get_disconnected_nodes_ok + returns_result_select_result select_result_I2 by (metis (no_types, hide_lams) ) qed -lemma get_owner_document_owner_document_in_heap: +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" @@ -2699,17 +2720,20 @@ next 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" + 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) + 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] + 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 @@ -2722,11 +2746,15 @@ next 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) + 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) + 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" @@ -2739,25 +2767,31 @@ next (\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)) + 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\ + 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 + 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(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) + 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" @@ -2773,8 +2807,9 @@ next 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] + 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 @@ -2787,11 +2822,16 @@ next 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) + 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) + 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" @@ -2804,30 +2844,36 @@ next (\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)) + 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\ + 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 + 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 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(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) + 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: +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)" @@ -2839,25 +2885,35 @@ proof - 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 + 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) + 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) + 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(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) + 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(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] + 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 @@ -2868,33 +2924,44 @@ lemma get_owner_document_child_same: 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) + 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 + 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 + 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 + 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) + 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 + 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" + 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 + 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] + 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\ @@ -2905,13 +2972,16 @@ proof - 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) + 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" + 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) @@ -2935,12 +3005,13 @@ proof - 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] + 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(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) @@ -2954,14 +3025,16 @@ proof - 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) + 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 - + l_get_disconnected_nodes_defs + l_get_owner_document_defs - + l_get_parent_defs + l_get_child_nodes_defs + +locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_get_disconnected_nodes_defs + l_get_owner_document_defs + + l_get_parent_defs + l_get_child_nodes_defs + assumes get_owner_document_disconnected_nodes: "heap_is_wellformed h \ known_ptrs h \ @@ -2970,28 +3043,34 @@ locale l_get_owner_document_wf = l_heap_is_wellformed_defs + l_type_wf + l_known node_ptr \ set disc_nodes \ h \ get_owner_document (cast node_ptr) \\<^sub>r document_ptr" assumes in_disconnected_nodes_no_parent: - "heap_is_wellformed h \ + "heap_is_wellformed h \ h \ get_parent node_ptr \\<^sub>r None\ h \ get_owner_document (cast node_ptr) \\<^sub>r owner_document \ h \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes \ 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 + 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)" assumes get_owner_document_child_same: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children \ child \ set children \ h \ get_owner_document ptr \\<^sub>r owner_document \ h \ get_owner_document (cast child) \\<^sub>r owner_document" + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children \ +child \ set children \ h \ get_owner_document ptr \\<^sub>r owner_document \ +h \ get_owner_document (cast child) \\<^sub>r owner_document" interpretation i_get_owner_document_wf?: l_get_owner_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr known_ptrs type_wf heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs get_owner_document + 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 + "l_get_owner_document_wf heap_is_wellformed type_wf known_ptr known_ptrs get_disconnected_nodes get_owner_document get_parent get_child_nodes" using known_ptrs_is_l_known_ptrs apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def)[1] @@ -3027,7 +3106,8 @@ proof - 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) + 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] @@ -3036,7 +3116,8 @@ proof - 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) + 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 { @@ -3051,12 +3132,14 @@ proof - 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] + 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 + 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) + 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: @@ -3086,7 +3169,8 @@ proof - 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) + 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 @@ -3104,10 +3188,12 @@ proof - 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) + 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) + 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)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ @@ -3119,20 +3205,27 @@ proof - 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) + 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)[1] - apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq) + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1] + apply (metis assms(1) assms(2) assms(3) local.get_root_node_no_parent + local.get_root_node_same_no_parent node_ptr returns_result_eq) using \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)[1] 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)[1] - apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits)[1] + apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs + split: option.splits)[1] + apply(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs + CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs + split: option.splits)[1] using \root |\| object_ptr_kinds h\ by(auto simp add: root_node_ptr) qed @@ -3146,9 +3239,12 @@ proof - apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits)+ apply (meson invoke_empty is_OK_returns_result_I) - apply(auto simp add: True a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 split: if_splits)[1] - apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) - by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3 is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + apply(auto simp add: True a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + split: if_splits)[1] + apply (metis True cast_document_ptr_not_node_ptr(2) is_document_ptr_kind_obtains + is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) + by (metis True cast_document_ptr_not_node_ptr(1) document_ptr_casts_commute3 + is_node_ptr_kind_none node_ptr_casts_commute3 option.case_eq_if) then show ?thesis using assms(1) assms(2) assms(3) assms(4) get_root_node_document by fastforce @@ -3156,7 +3252,8 @@ proof - 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) + 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" @@ -3166,32 +3263,46 @@ proof - 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)[1] - using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr + apply(auto simp add: a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!: bind_returns_result_E2 + intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)[1] + using assms(1) assms(2) assms(3) assms(4) local.get_root_node_no_parent + local.get_root_node_same_no_parent node_ptr returns_result_eq root_node_ptr by fastforce+ then show ?thesis apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def)[1] apply(split invoke_splits, (rule conjI | rule impI)+)+ using node_ptr \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) + 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 +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" +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)[1] + "l_get_owner_document_wf_get_root_node_wf heap_is_wellformed type_wf known_ptr known_ptrs +get_root_node get_owner_document" + apply(auto simp add: l_get_owner_document_wf_get_root_node_wf_def + l_get_owner_document_wf_get_root_node_wf_axioms_def instances)[1] using get_root_node_document apply blast using get_root_node_same_owner_document apply (blast, blast) done @@ -3203,8 +3314,8 @@ subsection \set\_attribute\ locale l_set_attribute_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + - l_set_attribute_get_disconnected_nodes + + l_set_attribute\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + + l_set_attribute_get_disconnected_nodes + l_set_attribute_get_child_nodes begin lemma set_attribute_preserves_wellformedness: @@ -3214,7 +3325,7 @@ lemma set_attribute_preserves_wellformedness: thm preserves_wellformedness_writes_needed apply(rule preserves_wellformedness_writes_needed[OF assms set_attribute_writes]) using set_attribute_get_child_nodes - apply(fast) + apply(fast) using set_attribute_get_disconnected_nodes apply(fast) by(auto simp add: all_args_def set_attribute_locs_def) end @@ -3240,25 +3351,25 @@ proof - then have "child \ set children" using remove_child remove_child_def by(auto elim!: bind_returns_heap_E dest: returns_result_eq split: if_splits) - then have h1: "\other_ptr other_children. other_ptr \ ptr + then have h1: "\other_ptr other_children. other_ptr \ ptr \ h \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" using assms(1) known_ptrs type_wf child_parent_dual by (meson child_parent_dual children option.inject returns_result_eq) have known_ptr: "known_ptr ptr" using known_ptrs - by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms - remove_child remove_child_ptr_in_heap) + by (meson is_OK_returns_heap_I l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms + remove_child remove_child_ptr_in_heap) obtain owner_document disc_nodes h' where - owner_document: "h \ get_owner_document (cast child) \\<^sub>r owner_document" and + owner_document: "h \ get_owner_document (cast child) \\<^sub>r owner_document" and disc_nodes: "h \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" and h': "h \ set_disconnected_nodes owner_document (child # disc_nodes) \\<^sub>h h'" and h2: "h' \ set_child_nodes ptr (remove1 child children) \\<^sub>h h2" using assms children unfolding remove_child_def apply(auto split: if_splits elim!: bind_returns_heap_E)[1] - by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure - get_owner_document_pure pure_returns_heap_eq returns_result_eq) + by (metis (full_types) get_child_nodes_pure get_disconnected_nodes_pure + get_owner_document_pure pure_returns_heap_eq returns_result_eq) have "object_ptr_kinds h = object_ptr_kinds h2" using remove_child_writes remove_child unfolding remove_child_locs_def @@ -3269,41 +3380,41 @@ proof - unfolding object_ptr_kinds_M_defs by simp have "type_wf h'" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", - OF set_disconnected_nodes_writes h'] + using 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 type_wf by(auto simp add: reflp_def transp_def) have "type_wf h2" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", - OF remove_child_writes remove_child] unfolding remove_child_locs_def - using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", + OF remove_child_writes remove_child] unfolding remove_child_locs_def + using set_disconnected_nodes_types_preserved set_child_nodes_types_preserved type_wf apply(auto simp add: reflp_def transp_def)[1] by blast then obtain children' where children': "h2 \ get_child_nodes ptr \\<^sub>r children'" using h2 set_child_nodes_get_child_nodes known_ptr - by (metis \object_ptr_kinds h = object_ptr_kinds h2\ children get_child_nodes_ok - get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I) + by (metis \object_ptr_kinds h = object_ptr_kinds h2\ children get_child_nodes_ok + get_child_nodes_ptr_in_heap is_OK_returns_result_E is_OK_returns_result_I) have "child \ set children'" - by (metis (mono_tags, lifting) \type_wf h'\ children children' distinct_remove1_removeAll h2 - known_ptr local.heap_is_wellformed_children_distinct - local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2 - wellformed) + by (metis (mono_tags, lifting) \type_wf h'\ children children' distinct_remove1_removeAll h2 + known_ptr local.heap_is_wellformed_children_distinct + local.set_child_nodes_get_child_nodes member_remove remove_code(1) select_result_I2 + wellformed) - moreover have "\other_ptr other_children. other_ptr \ ptr + moreover have "\other_ptr other_children. other_ptr \ ptr \ h' \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" proof - fix other_ptr other_children assume a1: "other_ptr \ ptr" and a3: "h' \ get_child_nodes other_ptr \\<^sub>r other_children" have "h \ get_child_nodes other_ptr \\<^sub>r other_children" - using get_child_nodes_reads set_disconnected_nodes_writes h' a3 + using get_child_nodes_reads set_disconnected_nodes_writes h' a3 apply(rule reads_writes_separate_backwards) using set_disconnected_nodes_get_child_nodes by fast show "child \ set other_children" using \h \ get_child_nodes other_ptr \\<^sub>r other_children\ a1 h1 by blast qed - then have "\other_ptr other_children. other_ptr \ ptr + then have "\other_ptr other_children. other_ptr \ ptr \ h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" proof - fix other_ptr other_children @@ -3311,21 +3422,21 @@ proof - have "h' \ get_child_nodes other_ptr \\<^sub>r other_children" using get_child_nodes_reads set_child_nodes_writes h2 a3 apply(rule reads_writes_separate_backwards) - using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes a1 set_child_nodes_get_child_nodes_different_pointers by metis then show "child \ set other_children" - using \\other_ptr other_children. \other_ptr \ ptr; h' \ get_child_nodes other_ptr \\<^sub>r other_children\ + using \\other_ptr other_children. \other_ptr \ ptr; h' \ get_child_nodes other_ptr \\<^sub>r other_children\ \ child \ set other_children\ a1 by blast qed - ultimately have ha: "\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children + ultimately have ha: "\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children" by (metis (full_types) children' returns_result_eq) moreover obtain ptrs where ptrs: "h2 \ object_ptr_kinds_M \\<^sub>r ptrs" by (simp add: object_ptr_kinds_M_defs) moreover have "\ptr. ptr \ set ptrs \ h2 \ ok (get_child_nodes ptr)" using \type_wf h2\ ptrs get_child_nodes_ok known_ptr - using \object_ptr_kinds h = object_ptr_kinds h2\ known_ptrs local.known_ptrs_known_ptr by auto - ultimately show "h2 \ get_parent child \\<^sub>r None" + using \object_ptr_kinds h = object_ptr_kinds h2\ known_ptrs local.known_ptrs_known_ptr by auto + ultimately show "h2 \ get_parent child \\<^sub>r None" apply(auto simp add: get_parent_def intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I)[1] proof - have "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child |\| object_ptr_kinds h" @@ -3333,11 +3444,11 @@ proof - then show "h2 \ check_in_heap (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child) \\<^sub>r ()" by (simp add: \object_ptr_kinds h = object_ptr_kinds h2\ check_in_heap_def) next - show "(\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children + show "(\other_ptr other_children. h2 \ get_child_nodes other_ptr \\<^sub>r other_children \ child \ set other_children) \ ptrs = sorted_list_of_set (fset (object_ptr_kinds h2)) \ (\ptr. ptr |\| object_ptr_kinds h2 \ h2 \ ok get_child_nodes ptr) \ - h2 \ filter_M (\ptr. Heap_Error_Monad.bind (get_child_nodes ptr) + h2 \ filter_M (\ptr. Heap_Error_Monad.bind (get_child_nodes ptr) (\children. return (child \ set children))) (sorted_list_of_set (fset (object_ptr_kinds h2))) \\<^sub>r []" by(auto intro!: filter_M_empty_I bind_pure_I) qed @@ -3359,22 +3470,22 @@ proof (standard, safe) obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr (remove1 child children_h) \\<^sub>h h'" using assms(2) - apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits)[1] + apply(auto simp add: remove_child_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits)[1] using pure_returns_heap_eq by fastforce have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes assms(2)]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have object_ptr_kinds_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" unfolding object_ptr_kinds_M_defs by simp @@ -3388,25 +3499,25 @@ proof (standard, safe) using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" using document_ptr_kinds_M_eq by auto - have children_eq: + have children_eq: "\ptr' children. ptr \ ptr' \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" - apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) + apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast - then have children_eq2: + then have children_eq2: "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: - "\document_ptr disconnected_nodes. document_ptr \ owner_document + have disconnected_nodes_eq: + "\document_ptr disconnected_nodes. document_ptr \ owner_document \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" - apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) + apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers by (metis (no_types, lifting) Un_iff owner_document select_result_I2) - then have disconnected_nodes_eq2: - "\document_ptr. document_ptr \ owner_document + then have disconnected_nodes_eq2: + "\document_ptr. document_ptr \ owner_document \ |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force @@ -3423,7 +3534,7 @@ proof (standard, safe) by(auto simp add: reflp_def transp_def) then have "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_child_nodes_writes h'] - using set_child_nodes_types_preserved + using set_child_nodes_types_preserved by(auto simp add: reflp_def transp_def) have children_h': "h' \ get_child_nodes ptr \\<^sub>r remove1 child children_h" @@ -3451,8 +3562,8 @@ proof (standard, safe) proof (cases "parent = ptr") case True then show ?thesis - using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' - get_child_nodes_ptr_in_heap + using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' + get_child_nodes_ptr_in_heap apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1] by (metis notin_set_remove1) next @@ -3473,22 +3584,22 @@ lemma remove_child_heap_is_wellformed_preserved: proof - obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr (remove1 child children_h) \\<^sub>h h'" using assms(2) apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1] + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] split: if_splits)[1] using pure_returns_heap_eq by fastforce have object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'" apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes assms(2)]) + OF remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have object_ptr_kinds_eq: "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h' \ object_ptr_kinds_M \\<^sub>r ptrs" unfolding object_ptr_kinds_M_defs by simp @@ -3502,29 +3613,32 @@ proof - using object_ptr_kinds_eq2 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3: "document_ptr_kinds h = document_ptr_kinds h'" using document_ptr_kinds_M_eq by auto - have children_eq: - "\ptr' children. ptr \ ptr' \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" - apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) + have children_eq: + "\ptr' children. ptr \ ptr' \ h \ get_child_nodes ptr' \\<^sub>r children = +h' \ get_child_nodes ptr' \\<^sub>r children" + apply(rule reads_writes_preserved[OF get_child_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast - then have children_eq2: - "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" + then have children_eq2: + "\ptr' children. ptr \ ptr' \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq: "\document_ptr disconnected_nodes. document_ptr \ owner_document - \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes + have disconnected_nodes_eq: "\document_ptr disconnected_nodes. document_ptr \ owner_document + \ h \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes = h' \ get_disconnected_nodes document_ptr \\<^sub>r disconnected_nodes" - apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) + apply(rule reads_writes_preserved[OF get_disconnected_nodes_reads remove_child_writes assms(2)]) unfolding remove_child_locs_def - using set_child_nodes_get_disconnected_nodes set_disconnected_nodes_get_disconnected_nodes_different_pointers + using set_child_nodes_get_disconnected_nodes + set_disconnected_nodes_get_disconnected_nodes_different_pointers by (metis (no_types, lifting) Un_iff owner_document select_result_I2) - then have disconnected_nodes_eq2: - "\document_ptr. document_ptr \ owner_document + then have disconnected_nodes_eq2: + "\document_ptr. document_ptr \ owner_document \ |h \ get_disconnected_nodes document_ptr|\<^sub>r = |h' \ get_disconnected_nodes document_ptr|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes ptr \\<^sub>r children_h" - apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 children_h] ) + apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads + set_disconnected_nodes_writes h2 children_h] ) by (simp add: set_disconnected_nodes_get_child_nodes) show "known_ptrs h'" @@ -3533,13 +3647,14 @@ proof - have "known_ptr ptr" using assms(3) using children_h get_child_nodes_ptr_in_heap local.known_ptrs_known_ptr by blast -have "type_wf h2" - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h2] + 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 type_wf by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_child_nodes_writes h'] - using set_child_nodes_types_preserved + using set_child_nodes_types_preserved by(auto simp add: reflp_def transp_def) have children_h': "h' \ get_child_nodes ptr \\<^sub>r remove1 child children_h" @@ -3561,14 +3676,16 @@ have "type_wf h2" using \type_wf h2\ set_child_nodes_get_child_nodes \known_ptr ptr\ h' by blast - have disconnected_nodes_h2: "h2 \ get_disconnected_nodes owner_document \\<^sub>r child # disconnected_nodes_h" + have disconnected_nodes_h2: + "h2 \ get_disconnected_nodes owner_document \\<^sub>r child # disconnected_nodes_h" using owner_document assms(2) h2 disconnected_nodes_h apply (auto simp add: remove_child_def split: if_splits)[1] apply(drule bind_returns_heap_E2) apply(auto split: if_splits)[1] apply(simp) by(auto simp add: local.set_disconnected_nodes_get_disconnected_nodes split: if_splits) - then have disconnected_nodes_h': "h' \ get_disconnected_nodes owner_document \\<^sub>r child # disconnected_nodes_h" + then have disconnected_nodes_h': + "h' \ get_disconnected_nodes owner_document \\<^sub>r child # disconnected_nodes_h" apply(rule reads_writes_separate_forwards[OF get_disconnected_nodes_reads set_child_nodes_writes h']) by (simp add: set_child_nodes_get_disconnected_nodes) @@ -3582,8 +3699,8 @@ have "type_wf h2" proof (cases "parent = ptr") case True then show ?thesis - using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' - get_child_nodes_ptr_in_heap + using a1 remove_child_removes_parent[OF assms(1) assms(2)] children_h children_h' + get_child_nodes_ptr_in_heap apply(auto simp add: parent_child_rel_def object_ptr_kinds_eq )[1] by (metis imageI notin_set_remove1) next @@ -3600,43 +3717,50 @@ 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 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)) + 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'" - apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3 - node_ptr_kinds_eq3)[1] + apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_eq3 document_ptr_kinds_eq3 + node_ptr_kinds_eq3)[1] proof - -fix node_ptr -assume 0: "\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' + fix node_ptr + assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_ptr. document_ptr |\| document_ptr_kinds h' \ +node_ptr \ set |h \ get_disconnected_nodes document_ptr|\<^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") case True - show ?thesis + show ?thesis apply(rule exI[where x=owner_document]) using children_eq2 disconnected_nodes_eq2 children_h children_h' disconnected_nodes_h' True - by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I - list.set_intros(1) select_result_I2) + by (metis (no_types, lifting) get_disconnected_nodes_ptr_in_heap is_OK_returns_result_I + list.set_intros(1) select_result_I2) next case False then show ?thesis - using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h - disconnected_nodes_h' + using 0 1 2 children_eq2 children_h children_h' disconnected_nodes_eq2 disconnected_nodes_h + disconnected_nodes_h' apply(auto simp add: children_eq2 disconnected_nodes_eq2 dest!: select_result_I2)[1] by (metis children_eq2 disconnected_nodes_eq2 finite_set_in in_set_remove1 list.set_intros(2)) qed qed - moreover + moreover { have h0: "a_distinct_lists h" using assms(1) by (simp add: heap_is_wellformed_def) - moreover have ha1: "(\x\set |h \ object_ptr_kinds_M|\<^sub>r. set |h \ get_child_nodes x|\<^sub>r) + moreover have ha1: "(\x\set |h \ object_ptr_kinds_M|\<^sub>r. set |h \ get_child_nodes x|\<^sub>r) \ (\x\set |h \ document_ptr_kinds_M|\<^sub>r. set |h \ get_disconnected_nodes x|\<^sub>r) = {}" using \a_distinct_lists h\ unfolding a_distinct_lists_def @@ -3646,9 +3770,9 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt have ha3: "child \ set |h \ get_child_nodes ptr|\<^sub>r" using child_in_children_h children_h by(simp) - have child_not_in: "\document_ptr. document_ptr |\| document_ptr_kinds h + have child_not_in: "\document_ptr. document_ptr |\| document_ptr_kinds h \ child \ set |h \ get_disconnected_nodes document_ptr|\<^sub>r" - using ha1 ha2 ha3 + using ha1 ha2 ha3 apply(simp) using IntI by fastforce moreover have "distinct |h \ object_ptr_kinds_M|\<^sub>r" @@ -3666,28 +3790,28 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt and 3: "distinct |h \ object_ptr_kinds_M|\<^sub>r" have 4: "distinct (concat ((map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) |h \ object_ptr_kinds_M|\<^sub>r)))" using 1 by(auto simp add: a_distinct_lists_def) - show "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) + show "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" proof(rule distinct_concat_map_I[OF 3[unfolded object_ptr_kinds_eq2], simplified]) fix x assume 5: "x |\| object_ptr_kinds h'" then have 6: "distinct |h \ get_child_nodes x|\<^sub>r" using 4 distinct_concat_map_E object_ptr_kinds_eq2 by fastforce - obtain children where children: "h \ get_child_nodes x \\<^sub>r children" - and distinct_children: "distinct children" - by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr - object_ptr_kinds_eq3 select_result_I) + obtain children where children: "h \ get_child_nodes x \\<^sub>r children" + and distinct_children: "distinct children" + by (metis "5" "6" type_wf assms(3) get_child_nodes_ok local.known_ptrs_known_ptr + object_ptr_kinds_eq3 select_result_I) obtain children' where children': "h' \ get_child_nodes x \\<^sub>r children'" using children children_eq children_h' by fastforce then have "distinct children'" proof (cases "ptr = x") case True - then show ?thesis + then show ?thesis using children distinct_children children_h children_h' by (metis children' distinct_remove1 returns_result_eq) next case False - then show ?thesis + then show ?thesis using children distinct_children children_eq[OF False] using children' distinct_lists_children h0 using select_result_I2 by fastforce @@ -3699,11 +3823,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt fix x y assume 5: "x |\| object_ptr_kinds h'" and 6: "y |\| object_ptr_kinds h'" and 7: "x \ y" obtain children_x where children_x: "h \ get_child_nodes x \\<^sub>r children_x" - by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "5" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children_y where children_y: "h \ get_child_nodes y \\<^sub>r children_y" - by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "6" type_wf assms(3) get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children_x' where children_x': "h' \ get_child_nodes x \\<^sub>r children_x'" using children_eq children_h' children_x by fastforce obtain children_y' where children_y': "h' \ get_child_nodes y \\<^sub>r children_y'" @@ -3752,12 +3876,12 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt assume 2: "distinct |h \ document_ptr_kinds_M|\<^sub>r" then have 4: "distinct (sorted_list_of_set (fset (document_ptr_kinds h')))" by simp - have 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + have 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" using h0 by(simp add: a_distinct_lists_def document_ptr_kinds_eq3) - show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" proof(rule distinct_concat_map_I[OF 4[unfolded document_ptr_kinds_eq3]]) fix x @@ -3775,7 +3899,7 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt by(simp) ultimately show ?thesis using 5 unfolding True - by simp + by simp next case False show ?thesis @@ -3797,11 +3921,11 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt obtain disc_nodes_y' where disc_nodes_y': "h' \ get_disconnected_nodes y \\<^sub>r disc_nodes_y'" using 5 get_disconnected_nodes_ok[OF \type_wf h'\, of y] document_ptr_kinds_eq2 by auto - have "distinct + have "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) |h \ document_ptr_kinds_M|\<^sub>r))" using h0 by (simp add: a_distinct_lists_def) then have 6: "set disc_nodes_x \ set disc_nodes_y = {}" - using \x \ y\ assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent + using \x \ y\ assms(1) disc_nodes_x disc_nodes_y local.heap_is_wellformed_one_disc_parent by blast have "set disc_nodes_x' \ set disc_nodes_y' = {}" @@ -3810,10 +3934,10 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt then have "y \ owner_document" using \x \ y\ by simp then have "disc_nodes_y' = disc_nodes_y" - using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' + using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' by auto have "disc_nodes_x' = child # disc_nodes_x" - using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h returns_result_eq + using disconnected_nodes_h' disc_nodes_x disc_nodes_x' True disconnected_nodes_h returns_result_eq by fastforce have "child \ set disc_nodes_y" using child_not_in disc_nodes_y 5 @@ -3829,7 +3953,7 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt then have "disc_nodes_x' = disc_nodes_x" using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' by auto have "disc_nodes_y' = child # disc_nodes_y" - using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h returns_result_eq + using disconnected_nodes_h' disc_nodes_y disc_nodes_y' True disconnected_nodes_h returns_result_eq by fastforce have "child \ set disc_nodes_x" using child_not_in disc_nodes_x 4 @@ -3843,7 +3967,7 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt using disconnected_nodes_eq[OF \x \ owner_document\] disc_nodes_x disc_nodes_x' by auto have "disc_nodes_y' = disc_nodes_y" using disconnected_nodes_eq[OF \y \ owner_document\] disc_nodes_y disc_nodes_y' by auto - then show ?thesis + then show ?thesis apply(unfold \disc_nodes_y' = disc_nodes_y\ \disc_nodes_x' = disc_nodes_x\) using 6 by auto qed @@ -3852,27 +3976,27 @@ assume 0: "\node_ptr\fset (node_ptr_kinds h'). (\document_pt using disc_nodes_x' disc_nodes_y' by auto qed next -fix x xa xb -assume 1: "xa \ fset (object_ptr_kinds h')" - and 2: "x \ set |h' \ get_child_nodes xa|\<^sub>r" - and 3: "xb \ fset (document_ptr_kinds h')" - and 4: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" + fix x xa xb + assume 1: "xa \ fset (object_ptr_kinds h')" + and 2: "x \ set |h' \ get_child_nodes xa|\<^sub>r" + and 3: "xb \ fset (document_ptr_kinds h')" + and 4: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" obtain disc_nodes where disc_nodes: "h \ get_disconnected_nodes xb \\<^sub>r disc_nodes" using 3 get_disconnected_nodes_ok[OF \type_wf h\, of xb] document_ptr_kinds_eq2 by auto obtain disc_nodes' where disc_nodes': "h' \ get_disconnected_nodes xb \\<^sub>r disc_nodes'" using 3 get_disconnected_nodes_ok[OF \type_wf h'\, of xb] document_ptr_kinds_eq2 by auto obtain children where children: "h \ get_child_nodes xa \\<^sub>r children" - by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E - local.known_ptrs_known_ptr object_ptr_kinds_eq3) + by (metis "1" type_wf assms(3) finite_set_in get_child_nodes_ok is_OK_returns_result_E + local.known_ptrs_known_ptr object_ptr_kinds_eq3) obtain children' where children': "h' \ get_child_nodes xa \\<^sub>r children'" using children children_eq children_h' by fastforce have "\x. x \ set |h \ get_child_nodes xa|\<^sub>r \ x \ set |h \ get_disconnected_nodes xb|\<^sub>r \ False" - using 1 3 - apply(fold \ object_ptr_kinds h = object_ptr_kinds h'\) - apply(fold \ document_ptr_kinds h = document_ptr_kinds h'\) + using 1 3 + apply(fold \ object_ptr_kinds h = object_ptr_kinds h'\) + apply(fold \ document_ptr_kinds h = document_ptr_kinds h'\) using children disc_nodes h0 apply(auto simp add: a_distinct_lists_def)[1] - by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2) + by (metis (no_types, lifting) h0 local.distinct_lists_no_parent select_result_I2) then have 5: "\x. x \ set children \ x \ set disc_nodes \ False" using children disc_nodes by fastforce have 6: "|h' \ get_child_nodes xa|\<^sub>r = children'" @@ -3891,29 +4015,29 @@ assume 1: "xa \ fset (object_ptr_kinds h')" using True children children_h by auto show ?thesis using disc_nodes' children' 5 2 4 children_h \distinct children_h\ disconnected_nodes_h' - apply(auto simp add: 6 7 - \xa = ptr\ \|h' \ get_child_nodes ptr|\<^sub>r = remove1 child children_h\ \children = children_h\)[1] - by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h - select_result_I2 set_ConsD) + apply(auto simp add: 6 7 + \xa = ptr\ \|h' \ get_child_nodes ptr|\<^sub>r = remove1 child children_h\ \children = children_h\)[1] + by (metis (no_types, lifting) disc_nodes disconnected_nodes_eq2 disconnected_nodes_h + select_result_I2 set_ConsD) next case False have "children' = children" using children' children children_eq[OF False[symmetric]] - by auto + by auto then show ?thesis proof (cases "xb = owner_document") case True then show ?thesis using disc_nodes disconnected_nodes_h disconnected_nodes_h' - using "2" "4" "5" "6" "7" False \children' = children\ assms(1) child_in_children_h - child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap - list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD + using "2" "4" "5" "6" "7" False \children' = children\ assms(1) child_in_children_h + child_parent_dual children children_h disc_nodes' get_child_nodes_ptr_in_heap + list.set_cases list.simps(3) option.simps(1) returns_result_eq set_ConsD by (metis (no_types, hide_lams) assms(3) type_wf) next case False then show ?thesis - using "2" "4" "5" "6" "7" \children' = children\ disc_nodes disc_nodes' - disconnected_nodes_eq returns_result_eq + using "2" "4" "5" "6" "7" \children' = children\ disc_nodes disc_nodes' + disconnected_nodes_eq returns_result_eq by metis qed qed @@ -3933,33 +4057,34 @@ lemma remove_heap_is_wellformed_preserved: 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) + 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'" and children: "h' \ get_child_nodes ptr \\<^sub>r children" -and known_ptrs: "known_ptrs h" -and type_wf: "type_wf h" -shows "child \ set children" + and known_ptrs: "known_ptrs h" + and type_wf: "type_wf h" + shows "child \ set children" proof - obtain owner_document children_h h2 disconnected_nodes_h 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" and - children_h: "h \ get_child_nodes ptr' \\<^sub>r children_h" and + children_h: "h \ get_child_nodes ptr' \\<^sub>r children_h" and child_in_children_h: "child \ set children_h" and disconnected_nodes_h: "h \ get_disconnected_nodes owner_document \\<^sub>r disconnected_nodes_h" and h2: "h \ set_disconnected_nodes owner_document (child # disconnected_nodes_h) \\<^sub>h h2" and h': "h2 \ set_child_nodes ptr' (remove1 child children_h) \\<^sub>h h'" using assms(2) - apply(auto simp add: remove_child_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_child_nodes_pure] - split: if_splits)[1] + apply(auto simp add: remove_child_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_child_nodes_pure] + split: if_splits)[1] using pure_returns_heap_eq by fastforce have "object_ptr_kinds h = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes remove_child]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes remove_child]) unfolding remove_child_locs_def using set_child_nodes_pointers_preserved set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) @@ -3971,8 +4096,8 @@ proof - by blast ultimately show ?thesis using remove_child_removes_parent remove_child_heap_is_wellformed_preserved child_parent_dual - by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child - returns_result_eq type_wf wellformed) + by (meson children known_ptrs local.known_ptrs_preserved option.distinct(1) remove_child + returns_result_eq type_wf wellformed) qed lemma remove_child_removes_first_child: @@ -3987,16 +4112,16 @@ proof - h2: "h \ set_disconnected_nodes owner_document (node_ptr # disc_nodes) \\<^sub>h h2" and "h2 \ set_child_nodes ptr children \\<^sub>h h'" using assms(5) - apply(auto simp add: remove_child_def - dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1] + apply(auto simp add: remove_child_def + dest!: bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated])[1] by(auto elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]) + bind_returns_heap_E2[rotated,OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]) have "known_ptr ptr" by (meson assms(3) assms(4) is_OK_returns_result_I get_child_nodes_ptr_in_heap known_ptrs_known_ptr) moreover have "h2 \ get_child_nodes ptr \\<^sub>r node_ptr # children" apply(rule reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes h2 assms(4)]) - using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers + using set_disconnected_nodes_get_child_nodes set_child_nodes_get_child_nodes_different_pointers by fast moreover have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h2] @@ -4017,9 +4142,9 @@ proof - using child_parent_dual assms by fastforce show ?thesis using assms remove_child_removes_first_child - by(auto simp add: remove_def - dest!: bind_returns_heap_E3[rotated, OF \h \ get_parent node_ptr \\<^sub>r Some ptr\, rotated] - bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated]) + by(auto simp add: remove_def + dest!: bind_returns_heap_E3[rotated, OF \h \ get_parent node_ptr \\<^sub>r Some ptr\, rotated] + bind_returns_heap_E3[rotated, OF assms(4) get_child_nodes_pure, rotated]) qed lemma remove_for_all_empty_children: @@ -4030,7 +4155,7 @@ lemma remove_for_all_empty_children: using assms proof(induct children arbitrary: h h') case Nil - then show ?case + then show ?case by simp next case (Cons a children) @@ -4039,8 +4164,8 @@ next with Cons show ?case proof(auto elim!: bind_returns_heap_E)[1] fix h2 - assume 0: "(\h h'. heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r children + assume 0: "(\h h'. heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r children \ h \ forall_M remove children \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r [])" and 1: "heap_is_wellformed h" and 2: "type_wf h" @@ -4055,17 +4180,17 @@ next moreover have "heap_is_wellformed h2" using 7 1 2 3 remove_child_heap_is_wellformed_preserved(3) by(auto simp add: remove_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - split: option.splits) + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + split: option.splits) moreover have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_writes 7] using \type_wf h\ remove_child_types_preserved by(auto simp add: a_remove_child_locs_def reflp_def transp_def) moreover have "object_ptr_kinds h = object_ptr_kinds h2" using 7 - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_writes]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_writes]) using remove_child_pointers_preserved by (auto simp add: reflp_def transp_def) then have "known_ptrs h2" @@ -4077,22 +4202,22 @@ next qed end -locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs - + l_get_child_nodes_defs + l_remove_defs + - assumes remove_child_preserves_type_wf: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' +locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_heap_is_wellformed_defs + + l_get_child_nodes_defs + l_remove_defs + + assumes remove_child_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' \ type_wf h'" - assumes remove_child_preserves_known_ptrs: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' + assumes remove_child_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ remove_child ptr child \\<^sub>h h' \ known_ptrs 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' + 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' + 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' @@ -4101,29 +4226,29 @@ locale l_remove_child_wf2 = l_type_wf + l_known_ptrs + l_remove_child_defs + l_h "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 \ child \ set children" - assumes remove_child_removes_first_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children - \ h \ remove_child ptr node_ptr \\<^sub>h h' + assumes remove_child_removes_first_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children + \ h \ remove_child ptr node_ptr \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children" - assumes remove_removes_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children + assumes remove_removes_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r node_ptr # children \ h \ remove node_ptr \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r children" - assumes remove_for_all_empty_children: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children + assumes remove_for_all_empty_children: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ get_child_nodes ptr \\<^sub>r children \ h \ forall_M remove children \\<^sub>h h' \ h' \ get_child_nodes ptr \\<^sub>r []" -interpretation i_remove_child_wf2?: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs - set_child_nodes set_child_nodes_locs get_parent get_parent_locs get_owner_document - get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel +interpretation i_remove_child_wf2?: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs + set_child_nodes set_child_nodes_locs get_parent get_parent_locs get_owner_document + get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel by unfold_locales declare l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -lemma remove_child_wf2_is_l_remove_child_wf2 [instances]: +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) @@ -4133,11 +4258,11 @@ lemma remove_child_wf2_is_l_remove_child_wf2 [instances]: using remove_removes_child apply fast using remove_for_all_empty_children apply fast done - + 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 + @@ -4154,7 +4279,7 @@ proof - obtain old_document parent_opt h2 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 } + 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; @@ -4163,22 +4288,22 @@ proof - 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]) + by(auto simp add: adopt_node_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) have "h2 \ get_child_nodes ptr' \\<^sub>r children" using h2 remove_child_removes_first_child assms(1) assms(2) assms(3) assms(5) by (metis list.set_intros(1) local.child_parent_dual option.simps(5) parent_opt returns_result_eq) then show ?thesis using h' - by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes] - split: if_splits) + by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes] + split: if_splits) qed -lemma adopt_node_document_in_heap: +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" @@ -4186,7 +4311,7 @@ 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" + 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; @@ -4195,10 +4320,10 @@ proof - 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]) + 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 @@ -4214,21 +4339,21 @@ proof - 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] ) + 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'", + 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'", + 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 + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) ultimately show ?thesis @@ -4236,7 +4361,7 @@ proof - qed qed end - + locale l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + @@ -4259,37 +4384,37 @@ proof - old_document: "h \ get_owner_document (cast node_ptr) \\<^sub>r old_document" and parent_opt: "h \ get_parent node_ptr \\<^sub>r parent_opt" and h': "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return () ) \\<^sub>h h'" - using adopt_node get_parent_pure + using adopt_node get_parent_pure by(auto simp add: adopt_node_def - elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - split: if_splits) + elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + split: if_splits) then have "h' \ get_child_nodes ptr \\<^sub>r children" - using adopt_node - apply(auto simp add: adopt_node_def - dest!: bind_returns_heap_E3[rotated, OF old_document, rotated] - bind_returns_heap_E3[rotated, OF parent_opt, rotated] - elim!: bind_returns_heap_E4[rotated, OF h', rotated])[1] - apply(auto split: if_splits - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] - apply (simp add: set_disconnected_nodes_get_child_nodes children - reads_writes_preserved[OF get_child_nodes_reads set_disconnected_nodes_writes]) + using adopt_node + apply(auto simp add: adopt_node_def + dest!: bind_returns_heap_E3[rotated, OF old_document, rotated] + bind_returns_heap_E3[rotated, OF parent_opt, rotated] + elim!: bind_returns_heap_E4[rotated, OF h', rotated])[1] + apply(auto split: if_splits + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] + apply (simp add: set_disconnected_nodes_get_child_nodes children + reads_writes_preserved[OF get_child_nodes_reads set_disconnected_nodes_writes]) using children by blast show ?thesis proof(insert parent_opt h', induct parent_opt) case None then show ?case - using child_parent_dual wellformed known_ptrs type_wf - \h' \ get_child_nodes ptr \\<^sub>r children\ returns_result_eq + using child_parent_dual wellformed known_ptrs type_wf + \h' \ get_child_nodes ptr \\<^sub>r children\ returns_result_eq by fastforce next case (Some option) then show ?case - using remove_child_removes_child \h' \ get_child_nodes ptr \\<^sub>r children\ known_ptrs type_wf - wellformed + using remove_child_removes_child \h' \ get_child_nodes ptr \\<^sub>r children\ known_ptrs type_wf + wellformed by auto qed qed @@ -4297,7 +4422,7 @@ qed lemma adopt_node_removes_child: 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'. + shows "\ptr' children'. h' \ get_child_nodes ptr' \\<^sub>r children' \ node_ptr \ set children'" using adopt_node_removes_child_step assms by blast @@ -4309,12 +4434,12 @@ lemma adopt_node_preserves_wellformedness: 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" - and - parent_opt: "h \ get_parent child \\<^sub>r parent_opt" - and - h2: "h \ (case parent_opt of Some parent \ remove_child parent child | None \ return ()) \\<^sub>h h2" - and + old_document: "h \ get_owner_document (cast child) \\<^sub>r old_document" + and + parent_opt: "h \ get_parent child \\<^sub>r parent_opt" + and + h2: "h \ (case parent_opt of Some parent \ remove_child parent child | None \ return ()) \\<^sub>h h2" + and h': "h2 \ (if document_ptr \ old_document then do { old_disc_nodes \ get_disconnected_nodes old_document; set_disconnected_nodes old_document (remove1 child old_disc_nodes); @@ -4324,18 +4449,18 @@ proof - return () }) \\<^sub>h h'" using assms(2) - by(auto simp add: adopt_node_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_parent_pure]) + by(auto simp add: adopt_node_def elim!: bind_returns_heap_E + dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] + pure_returns_heap_eq[rotated, OF get_parent_pure]) have object_ptr_kinds_h_eq3: "object_ptr_kinds h = object_ptr_kinds h2" using h2 apply(simp split: option.splits) - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF remove_child_writes]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF remove_child_writes]) using remove_child_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h: - "\ptrs. h \ object_ptr_kinds_M \\<^sub>r ptrs = h2 \ object_ptr_kinds_M \\<^sub>r ptrs" + 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" unfolding object_ptr_kinds_M_defs by simp then have object_ptr_kinds_eq_h: "|h \ object_ptr_kinds_M|\<^sub>r = |h2 \ object_ptr_kinds_M|\<^sub>r" by simp @@ -4344,13 +4469,13 @@ 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) + by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) have "type_wf h2" using h2 remove_child_preserves_type_wf known_ptrs type_wf - by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure) + 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) + 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 @@ -4362,20 +4487,20 @@ proof - docs_neq: "document_ptr \ old_document" and old_disc_nodes: "h2 \ get_disconnected_nodes old_document \\<^sub>r old_disc_nodes" and h3: "h2 \ set_disconnected_nodes old_document (remove1 child old_disc_nodes) \\<^sub>h h3" and - disc_nodes_document_ptr_h3: - "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" and + disc_nodes_document_ptr_h3: + "h3 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" and h': "h3 \ set_disconnected_nodes document_ptr (child # disc_nodes_document_ptr_h3) \\<^sub>h h'" using h' - by(auto elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + by(auto elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) have object_ptr_kinds_h2_eq3: "object_ptr_kinds h2 = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes h3]) - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + 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" + 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) @@ -4387,7 +4512,7 @@ proof - 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: + 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) @@ -4396,11 +4521,11 @@ proof - using select_result_eq by force have object_ptr_kinds_h3_eq3: "object_ptr_kinds h3 = object_ptr_kinds h'" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes h']) - using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", + OF set_disconnected_nodes_writes h']) + using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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_eq_h3: "|h3 \ object_ptr_kinds_M|\<^sub>r = |h' \ object_ptr_kinds_M|\<^sub>r" @@ -4413,7 +4538,7 @@ proof - using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto then have document_ptr_kinds_eq3_h3: "document_ptr_kinds h3 = document_ptr_kinds h'" using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto - have children_eq_h3: + have children_eq_h3: "\ptr children. h3 \ get_child_nodes ptr \\<^sub>r children = h' \ get_child_nodes ptr \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) @@ -4421,25 +4546,25 @@ proof - then have children_eq2_h3: "\ptr. |h3 \ get_child_nodes ptr|\<^sub>r = |h' \ get_child_nodes ptr|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. old_document \ doc_ptr + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. old_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 (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h2: - "\doc_ptr. old_document \ doc_ptr + then have disconnected_nodes_eq2_h2: + "\doc_ptr. old_document \ doc_ptr \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2: + obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2: "h2 \ get_disconnected_nodes old_document \\<^sub>r disc_nodes_old_document_h2" using old_disc_nodes by blast then have disc_nodes_old_document_h3: "h3 \ get_disconnected_nodes old_document \\<^sub>r remove1 child disc_nodes_old_document_h2" - using h3 old_disc_nodes returns_result_eq set_disconnected_nodes_get_disconnected_nodes + using h3 old_disc_nodes returns_result_eq set_disconnected_nodes_get_disconnected_nodes by fastforce have "distinct disc_nodes_old_document_h2" - using disc_nodes_old_document_h2 local.heap_is_wellformed_disconnected_nodes_distinct wellformed_h2 + using disc_nodes_old_document_h2 local.heap_is_wellformed_disconnected_nodes_distinct wellformed_h2 by blast @@ -4451,17 +4576,17 @@ proof - next case (Some option) then show ?case - using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_child_writes] - type_wf remove_child_types_preserved + using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF remove_child_writes] + type_wf remove_child_types_preserved by (simp add: reflp_def transp_def) qed then have "type_wf h3" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h3] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) then have "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) have "known_ptrs h3" @@ -4469,17 +4594,17 @@ proof - 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 + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: - "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: + "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: + have disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_document_ptr_h3" using disconnected_nodes_eq_h2 docs_neq disc_nodes_document_ptr_h3 by auto have disc_nodes_document_ptr_h': " @@ -4490,11 +4615,11 @@ proof - have document_ptr_in_heap: "document_ptr |\| document_ptr_kinds h2" using disc_nodes_document_ptr_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1) unfolding heap_is_wellformed_def - using disc_nodes_document_ptr_h2 get_disconnected_nodes_ptr_in_heap by blast + using disc_nodes_document_ptr_h2 get_disconnected_nodes_ptr_in_heap by blast have old_document_in_heap: "old_document |\| document_ptr_kinds h2" using disc_nodes_old_document_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1) unfolding heap_is_wellformed_def - using get_disconnected_nodes_ptr_in_heap old_disc_nodes by blast + using get_disconnected_nodes_ptr_in_heap old_disc_nodes by blast have "child \ set disc_nodes_old_document_h2" proof (insert parent_opt h2, induct parent_opt) @@ -4503,36 +4628,36 @@ proof - by(auto) moreover have "a_owner_document_valid h" using assms(1) heap_is_wellformed_def by(simp add: heap_is_wellformed_def) - ultimately show ?case - using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)] - in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast + ultimately show ?case + using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)] + in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast next case (Some option) then show ?case apply(simp split: option.splits) - using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes known_ptrs + using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes known_ptrs by blast qed have "child \ set (remove1 child disc_nodes_old_document_h2)" - using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2 \distinct disc_nodes_old_document_h2\ + using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2 \distinct disc_nodes_old_document_h2\ by auto have "child \ set disc_nodes_document_ptr_h3" proof - have "a_distinct_lists h2" using heap_is_wellformed_def wellformed_h2 by blast - then have 0: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + then have 0: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) |h2 \ document_ptr_kinds_M|\<^sub>r))" by(simp add: a_distinct_lists_def) show ?thesis - using distinct_concat_map_E(1)[OF 0] \child \ set disc_nodes_old_document_h2\ - disc_nodes_old_document_h2 disc_nodes_document_ptr_h2 - by (meson \type_wf h2\ docs_neq known_ptrs local.get_owner_document_disconnected_nodes - local.known_ptrs_preserved object_ptr_kinds_h_eq3 returns_result_eq wellformed_h2) + using distinct_concat_map_E(1)[OF 0] \child \ set disc_nodes_old_document_h2\ + disc_nodes_old_document_h2 disc_nodes_document_ptr_h2 + by (meson \type_wf h2\ docs_neq known_ptrs local.get_owner_document_disconnected_nodes + local.known_ptrs_preserved object_ptr_kinds_h_eq3 returns_result_eq wellformed_h2) qed have child_in_heap: "child |\| node_ptr_kinds h" - using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]] - node_ptr_kinds_commutes by blast + using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]] + node_ptr_kinds_commutes by blast have "a_acyclic_heap h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) have "parent_child_rel h' \ parent_child_rel h2" @@ -4540,8 +4665,8 @@ proof - fix x assume "x \ parent_child_rel h'" then show "x \ parent_child_rel h2" - using object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3 - mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong + using object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3 + mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong unfolding parent_child_rel_def by(simp) qed @@ -4553,39 +4678,46 @@ proof - then have "a_all_ptrs_in_heap h3" apply(auto simp add: a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1] apply (simp add: children_eq2_h2 object_ptr_kinds_h2_eq3 subset_code(1)) - by (metis (no_types, lifting) \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'" + 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] - 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) + 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) then have "a_owner_document_valid h'" - apply(simp add: a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3 - object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 children_eq2_h2 children_eq2_h3 ) - by (smt disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 - disc_nodes_old_document_h2 disc_nodes_old_document_h3 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_in_heap - document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 in_set_remove1 - list.set_intros(1) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 - object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2 - set_subset_Cons subset_code(1)) + apply(simp add: a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3 + object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 children_eq2_h2 children_eq2_h3 ) + by (smt disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2 + disc_nodes_old_document_h2 disc_nodes_old_document_h3 + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_in_heap + document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 in_set_remove1 + list.set_intros(1) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 + object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2 + set_subset_Cons subset_code(1)) have a_distinct_lists_h2: "a_distinct_lists h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h'" - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2 - children_eq2_h2 children_eq2_h3)[1] + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2 + children_eq2_h2 children_eq2_h3)[1] proof - assume 1: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" - and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h2)))))" - and 3: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + and 3: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h2). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" - show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) + show "distinct (concat (map (\document_ptr. |h' \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h')))))" proof(rule distinct_concat_map_I) show "distinct (sorted_list_of_set (fset (document_ptr_kinds h')))" @@ -4594,32 +4726,32 @@ proof - fix x assume a1: "x \ set (sorted_list_of_set (fset (document_ptr_kinds h')))" have 4: "distinct |h2 \ get_disconnected_nodes x|\<^sub>r" - using a_distinct_lists_h2 "2" a1 concat_map_all_distinct document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 + using a_distinct_lists_h2 "2" a1 concat_map_all_distinct document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 by fastforce then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" proof (cases "old_document \ x") case True - then show ?thesis + then show ?thesis proof (cases "document_ptr \ x") case True - then show ?thesis - using disconnected_nodes_eq2_h2[OF \old_document \ x\] - disconnected_nodes_eq2_h3[OF \document_ptr \ x\] 4 + then show ?thesis + using disconnected_nodes_eq2_h2[OF \old_document \ x\] + disconnected_nodes_eq2_h3[OF \document_ptr \ x\] 4 by(auto) next case False - then show ?thesis + then show ?thesis using disc_nodes_document_ptr_h3 disc_nodes_document_ptr_h' 4 - \child \ set disc_nodes_document_ptr_h3\ + \child \ set disc_nodes_document_ptr_h3\ by(auto simp add: disconnected_nodes_eq2_h2[OF \old_document \ x\] ) qed next case False then show ?thesis - by (metis (no_types, hide_lams) \distinct disc_nodes_old_document_h2\ - disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 - distinct_remove1 docs_neq select_result_I2) + by (metis (no_types, hide_lams) \distinct disc_nodes_old_document_h2\ + disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 + distinct_remove1 docs_neq select_result_I2) qed next fix x y @@ -4628,7 +4760,7 @@ proof - and a2: "x \ y" moreover have 5: "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes y|\<^sub>r = {}" - using 2 calculation + using 2 calculation by (auto simp add: document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 dest: distinct_concat_map_E(1)) ultimately show "set |h' \ get_disconnected_nodes x|\<^sub>r \ set |h' \ get_disconnected_nodes y|\<^sub>r = {}" proof(cases "old_document = x") @@ -4641,21 +4773,21 @@ proof - proof(cases "document_ptr = y") case True then show ?thesis - using 5 True select_result_I2[OF disc_nodes_document_ptr_h'] + using 5 True select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] select_result_I2[OF disc_nodes_old_document_h2] select_result_I2[OF disc_nodes_old_document_h3] \old_document = x\ by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ - \document_ptr \ x\ disconnected_nodes_eq2_h3 disjoint_iff_not_equal - notin_set_remove1 set_ConsD) + \document_ptr \ x\ disconnected_nodes_eq2_h3 disjoint_iff_not_equal + notin_set_remove1 set_ConsD) next case False - then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + then show ?thesis + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h2] select_result_I2[OF disc_nodes_old_document_h3] - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \old_document = x\ + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \old_document = x\ docs_neq \old_document \ y\ by (metis (no_types, lifting) disjoint_iff_not_equal notin_set_remove1) qed @@ -4668,49 +4800,49 @@ proof - proof(cases "document_ptr = x") case True show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] - \old_document \ x\ \old_document = y\ \document_ptr = x\ - apply(simp) - by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ - disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1) + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + select_result_I2[OF disc_nodes_document_ptr_h2] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] + \old_document \ x\ \old_document = y\ \document_ptr = x\ + apply(simp) + by (metis (no_types, lifting) \child \ set (remove1 child disc_nodes_old_document_h2)\ + disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1) next case False then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] - \old_document \ x\ \old_document = y\ \document_ptr \ x\ - by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 - disjoint_iff_not_equal docs_neq notin_set_remove1) + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + select_result_I2[OF disc_nodes_document_ptr_h2] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] + \old_document \ x\ \old_document = y\ \document_ptr \ x\ + by (metis (no_types, lifting) disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 + disjoint_iff_not_equal docs_neq notin_set_remove1) qed next case False have "set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}" by (metis DocumentMonad.ptr_kinds_M_ok DocumentMonad.ptr_kinds_M_ptr_kinds False - \type_wf h2\ a1 disc_nodes_old_document_h2 document_ptr_kinds_M_def - document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok - local.heap_is_wellformed_one_disc_parent returns_result_select_result - wellformed_h2) + \type_wf h2\ a1 disc_nodes_old_document_h2 document_ptr_kinds_M_def + document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok + local.heap_is_wellformed_one_disc_parent returns_result_select_result + wellformed_h2) then show ?thesis proof(cases "document_ptr = x") case True then have "document_ptr \ y" using \x \ y\ by auto have "set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}" - using \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ + using \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ by blast - then show ?thesis - using 5 select_result_I2[OF disc_nodes_document_ptr_h'] + then show ?thesis + using 5 select_result_I2[OF disc_nodes_document_ptr_h'] select_result_I2[OF disc_nodes_document_ptr_h2] - select_result_I2[OF disc_nodes_old_document_h2] - select_result_I2[OF disc_nodes_old_document_h3] + select_result_I2[OF disc_nodes_old_document_h2] + select_result_I2[OF disc_nodes_old_document_h3] \old_document \ x\ \old_document \ y\ \document_ptr = x\ \document_ptr \ y\ - \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ by(auto) @@ -4720,33 +4852,33 @@ proof - proof(cases "document_ptr = y") case True have f1: "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set disc_nodes_document_ptr_h3 = {}" - using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - \document_ptr \ x\ select_result_I2[OF disc_nodes_document_ptr_h3, symmetric] - disconnected_nodes_eq2_h2[OF docs_neq[symmetric], symmetric] + using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + \document_ptr \ x\ select_result_I2[OF disc_nodes_document_ptr_h3, symmetric] + disconnected_nodes_eq2_h2[OF docs_neq[symmetric], symmetric] by (simp add: "5" True) - moreover have f1: - "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes old_document|\<^sub>r = {}" - using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 - \old_document \ x\ - by (metis (no_types, lifting) a0 distinct_concat_map_E(1) document_ptr_kinds_eq3_h2 - document_ptr_kinds_eq3_h3 finite_fset fmember.rep_eq set_sorted_list_of_set) + moreover have f1: + "set |h2 \ get_disconnected_nodes x|\<^sub>r \ set |h2 \ get_disconnected_nodes old_document|\<^sub>r = {}" + using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 + \old_document \ x\ + by (metis (no_types, lifting) a0 distinct_concat_map_E(1) document_ptr_kinds_eq3_h2 + document_ptr_kinds_eq3_h3 finite_fset fmember.rep_eq set_sorted_list_of_set) ultimately show ?thesis using 5 select_result_I2[OF disc_nodes_document_ptr_h'] - select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ + select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ \document_ptr \ x\ \document_ptr = y\ - \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 - disconnected_nodes_eq2_h3 + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 + disconnected_nodes_eq2_h3 by auto next case False then show ?thesis - using 5 - select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ + using 5 + select_result_I2[OF disc_nodes_old_document_h2] \old_document \ x\ \document_ptr \ x\ \document_ptr \ y\ - \child \ set disc_nodes_old_document_h2\ + \child \ set disc_nodes_old_document_h2\ disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 - by (metis \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ - empty_iff inf.idem) + by (metis \set |h2 \ get_disconnected_nodes y|\<^sub>r \ set disc_nodes_old_document_h2 = {}\ + empty_iff inf.idem) qed qed qed @@ -4754,21 +4886,21 @@ proof - qed next fix x xa xb - assume 0: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) + assume 0: "distinct (concat (map (\ptr. |h' \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" - and 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h2)))))" - and 2: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + and 2: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h2). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" - and 3: "xa |\| object_ptr_kinds h'" - and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" - and 5: "xb |\| document_ptr_kinds h'" - and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" + and 3: "xa |\| object_ptr_kinds h'" + and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" + and 5: "xb |\| document_ptr_kinds h'" + and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" then show False using \child \ set disc_nodes_old_document_h2\ disc_nodes_document_ptr_h' - disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2 - document_ptr_kinds_eq2_h3 old_document_in_heap + disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3 + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2 + document_ptr_kinds_eq2_h3 old_document_in_heap apply(auto)[1] apply(cases "xb = old_document") proof - @@ -4777,19 +4909,19 @@ proof - assume a3: "h3 \ get_disconnected_nodes old_document \\<^sub>r remove1 child disc_nodes_old_document_h2" assume a4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" assume "document_ptr_kinds h2 = document_ptr_kinds h'" - assume a5: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + assume a5: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" have f6: "old_document |\| document_ptr_kinds h'" using a1 \xb |\| document_ptr_kinds h'\ by blast have f7: "|h2 \ get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2" using a2 by simp have "x \ set disc_nodes_old_document_h2" - using f6 a3 a1 by (metis (no_types) \type_wf h'\ \x \ set |h' \ get_disconnected_nodes xb|\<^sub>r\ - disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq - returns_result_select_result set_remove1_subset subsetCE) + using f6 a3 a1 by (metis (no_types) \type_wf h'\ \x \ set |h' \ get_disconnected_nodes xb|\<^sub>r\ + disconnected_nodes_eq_h3 docs_neq get_disconnected_nodes_ok returns_result_eq + returns_result_select_result set_remove1_subset subsetCE) then have "set |h' \ get_child_nodes xa|\<^sub>r \ set |h2 \ get_disconnected_nodes xb|\<^sub>r = {}" using f7 f6 a5 a4 \xa |\| object_ptr_kinds h'\ - by fastforce + by fastforce then show ?thesis using \x \ set disc_nodes_old_document_h2\ a1 a4 f7 by blast next @@ -4802,11 +4934,11 @@ proof - assume a7: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" assume a8: "x \ set |h' \ get_child_nodes xa|\<^sub>r" assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'" - assume a10: "\doc_ptr. old_document \ doc_ptr + assume a10: "\doc_ptr. old_document \ doc_ptr \ |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" - assume a11: "\doc_ptr. document_ptr \ doc_ptr + assume a11: "\doc_ptr. document_ptr \ doc_ptr \ |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" - assume a12: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) + assume a12: "(\x\fset (object_ptr_kinds h'). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h2 \ get_disconnected_nodes x|\<^sub>r) = {}" have f13: "\d. d \ set |h' \ document_ptr_kinds_M|\<^sub>r \ h2 \ ok get_disconnected_nodes d" using a9 \type_wf h2\ get_disconnected_nodes_ok @@ -4818,12 +4950,12 @@ proof - by (meson UN_I disjoint_iff_not_equal fmember.rep_eq) then have "x = child" using f13 a11 a10 a7 a5 a2 a1 - by (metis (no_types, lifting) select_result_I2 set_ConsD) + by (metis (no_types, lifting) select_result_I2 set_ConsD) then have "child \ set disc_nodes_old_document_h2" using f14 a12 a8 a6 a4 - by (metis \type_wf h'\ adopt_node_removes_child assms(1) assms(2) type_wf - get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3 - object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result) + by (metis \type_wf h'\ adopt_node_removes_child assms(1) assms(2) type_wf + get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3 + object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result) then show ?thesis using \child \ set disc_nodes_old_document_h2\ by fastforce qed @@ -4846,7 +4978,7 @@ proof - obtain old_document parent_opt h2 where old_document: "h \ get_owner_document (cast node_ptr) \\<^sub>r old_document" and parent_opt: "h \ get_parent node_ptr \\<^sub>r parent_opt" and - h2: "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return ()) \\<^sub>h h2" + h2: "h \ (case parent_opt of Some parent \ remove_child parent node_ptr | None \ return ()) \\<^sub>h h2" and h': "h2 \ (if owner_document \ old_document then do { old_disc_nodes \ get_disconnected_nodes old_document; @@ -4857,9 +4989,9 @@ proof - return () }) \\<^sub>h h'" using assms(2) - by(auto simp add: adopt_node_def elim!: bind_returns_heap_E - dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure] - pure_returns_heap_eq[rotated, OF get_parent_pure]) + 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") @@ -4882,9 +5014,9 @@ proof - using assms(3) h' list.set_intros(1) select_result_I2 set_disconnected_nodes_get_disconnected_nodes apply(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1] proof - - fix x and h'a and xb + fix x and h'a and xb assume a1: "h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes" - assume a2: "\h document_ptr disc_nodes h'. h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' + assume a2: "\h document_ptr disc_nodes h'. h \ set_disconnected_nodes document_ptr disc_nodes \\<^sub>h h' \ h' \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes" assume "h'a \ set_disconnected_nodes owner_document (node_ptr # xb) \\<^sub>h h'" then have "node_ptr # xb = disc_nodes" @@ -4896,45 +5028,45 @@ proof - qed end -interpretation i_adopt_node_wf?: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs - remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr - type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs - remove heap_is_wellformed parent_child_rel +interpretation i_adopt_node_wf?: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs + remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr + type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs + remove heap_is_wellformed parent_child_rel by(simp add: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -interpretation i_adopt_node_wf2?: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs - remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs - set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr - type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs - remove heap_is_wellformed parent_child_rel get_root_node get_root_node_locs +interpretation i_adopt_node_wf2?: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs + remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr + type_wf get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs + remove heap_is_wellformed parent_child_rel get_root_node get_root_node_locs by(simp add: l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_adopt_node_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] -locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs - + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + +locale l_adopt_node_wf = l_heap_is_wellformed + l_known_ptrs + l_type_wf + l_adopt_node_defs + + l_get_child_nodes_defs + l_get_disconnected_nodes_defs + assumes adopt_node_preserves_wellformedness: - "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h + "heap_is_wellformed h \ h \ adopt_node document_ptr child \\<^sub>h h' \ known_ptrs h \ type_wf h \ heap_is_wellformed h'" assumes adopt_node_removes_child: - "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h2 - \ h2 \ get_child_nodes ptr \\<^sub>r children \ known_ptrs h + "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h2 + \ h2 \ get_child_nodes ptr \\<^sub>r children \ known_ptrs h \ type_wf h \ node_ptr \ set children" assumes adopt_node_node_in_disconnected_nodes: - "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h' - \ h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes + "heap_is_wellformed h \ h \ adopt_node owner_document node_ptr \\<^sub>h h' + \ h' \ get_disconnected_nodes owner_document \\<^sub>r disc_nodes \ known_ptrs h \ type_wf h \ node_ptr \ set disc_nodes" - assumes adopt_node_removes_first_child: "heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ adopt_node owner_document node \\<^sub>h h' - \ h \ get_child_nodes ptr' \\<^sub>r node # children + assumes adopt_node_removes_first_child: "heap_is_wellformed h \ type_wf h \ known_ptrs h + \ 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" -lemma adopt_node_wf_is_l_adopt_node_wf [instances]: +lemma adopt_node_wf_is_l_adopt_node_wf [instances]: "l_adopt_node_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes get_disconnected_nodes known_ptrs adopt_node" using heap_is_wellformed_is_l_heap_is_wellformed known_ptrs_is_l_known_ptrs @@ -4970,52 +5102,52 @@ proof - h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disc_nodes) \\<^sub>h h3" and h': "h3 \ a_insert_node ptr node reference_child \\<^sub>h h'" using assms(5) - by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - split: if_splits option.splits) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + split: if_splits option.splits) have "h2 \ get_child_nodes ptr' \\<^sub>r children" using h2 adopt_node_removes_first_child assms(1) assms(2) assms(3) assms(6) by simp then have "h3 \ get_child_nodes ptr' \\<^sub>r children" using h3 - by(auto simp add: set_disconnected_nodes_get_child_nodes - dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]) + by(auto simp add: set_disconnected_nodes_get_child_nodes + dest!: reads_writes_separate_forwards[OF get_child_nodes_reads set_disconnected_nodes_writes]) then show ?thesis using h' assms(4) - apply(auto simp add: a_insert_node_def - elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1] - by(auto simp add: set_child_nodes_get_child_nodes_different_pointers - elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes]) + apply(auto simp add: a_insert_node_def + elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated])[1] + by(auto simp add: set_child_nodes_get_child_nodes_different_pointers + elim!: reads_writes_separate_forwards[OF get_child_nodes_reads set_child_nodes_writes]) qed end -locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs - + l_insert_before_defs + l_get_child_nodes_defs + -assumes insert_before_removes_child: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ ptr \ ptr' - \ h \ insert_before ptr node child \\<^sub>h h' - \ h \ get_child_nodes ptr' \\<^sub>r node # children +locale l_insert_before_wf = l_heap_is_wellformed_defs + l_type_wf + l_known_ptrs + + l_insert_before_defs + l_get_child_nodes_defs + + assumes insert_before_removes_child: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ ptr \ ptr' + \ h \ insert_before ptr node child \\<^sub>h h' + \ h \ get_child_nodes ptr' \\<^sub>r node # children \ h' \ get_child_nodes ptr' \\<^sub>r children" -interpretation i_insert_before_wf?: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs - get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_ancestors get_ancestors_locs - adopt_node adopt_node_locs set_disconnected_nodes - set_disconnected_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs get_owner_document insert_before - insert_before_locs append_child type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel +interpretation i_insert_before_wf?: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs + get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_ancestors get_ancestors_locs + adopt_node adopt_node_locs set_disconnected_nodes + set_disconnected_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs get_owner_document insert_before + insert_before_locs append_child type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel by(simp add: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -lemma insert_before_wf_is_l_insert_before_wf [instances]: +lemma insert_before_wf_is_l_insert_before_wf [instances]: "l_insert_before_wf heap_is_wellformed type_wf known_ptr known_ptrs insert_before get_child_nodes" apply(auto simp add: l_insert_before_wf_def l_insert_before_wf_axioms_def instances)[1] using insert_before_removes_child apply fast @@ -5043,26 +5175,26 @@ proof - 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 + "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(2) - by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - split: if_splits option.splits) + by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) have "known_ptr ptr" - by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs - l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) + by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I known_ptrs + l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document) have "type_wf h2" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF adopt_node_writes h2] @@ -5070,18 +5202,18 @@ proof - 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 + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF insert_node_writes h'] - using set_child_nodes_types_preserved + 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]) + 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 + 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 ) @@ -5097,10 +5229,10 @@ proof - using adopt_node_preserves_wellformedness[OF wellformed h2] known_ptrs type_wf . have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h = object_ptr_kinds h'", - OF set_disconnected_nodes_writes 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 + 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) @@ -5113,17 +5245,17 @@ proof - 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']) + 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 + using set_child_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) - then have object_ptr_kinds_M_eq_h3: + 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: + 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" @@ -5134,68 +5266,68 @@ proof - show "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 + 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 + 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" + 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 + 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: + 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" + 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" + 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' + 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" + 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]) + 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: + have child_not_in_any_children: "\p children. h2 \ get_child_nodes p \\<^sub>r children \ node \ set children" using wellformed h2 adopt_node_removes_child \type_wf h\ \known_ptrs h\ by auto have "node \ set disconnected_nodes_h2" - using disconnected_nodes_h2 h2 adopt_node_node_in_disconnected_nodes assms(1) - \type_wf h\ \known_ptrs h\ by blast - have node_not_in_disconnected_nodes: - "\d. d |\| document_ptr_kinds h3 \ node \ set |h3 \ get_disconnected_nodes d|\<^sub>r" + 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" @@ -5203,26 +5335,26 @@ proof - 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 + 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 + 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) + 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 + using disconnected_nodes_eq2_h2[OF False] \node \ set disconnected_nodes_h2\ + disconnected_nodes_h2 by fastforce qed qed - have "cast node \ ptr" + have "cast node \ ptr" using ancestors node_not_in_ancestors get_ancestors_ptr by fast @@ -5232,7 +5364,7 @@ proof - 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 + 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]) @@ -5256,14 +5388,14 @@ proof - 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) + apply(auto simp add: parent_child_rel_def object_ptr_kinds_M_eq3_h' children_eq2_h3 + insert_before_list_node_in_set)[1] + apply (metis (no_types, lifting) children_eq2_h3 insert_before_list_in_set select_result_I2) by (metis (no_types, lifting) children_eq2_h3 imageI insert_before_list_in_set select_result_I2) ultimately show ?thesis by(auto simp add: acyclic_heap_def) qed - + moreover have "a_all_ptrs_in_heap h2" using wellformed_h2 by (simp add: heap_is_wellformed_def) @@ -5271,49 +5403,57 @@ proof - proof - have "a_all_ptrs_in_heap h3" using \a_all_ptrs_in_heap h2\ - apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2 node_ptr_kinds_eq2_h2 + apply(auto simp add: a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2 node_ptr_kinds_eq2_h2 children_eq_h2)[1] using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 using node_ptr_kinds_eq2_h2 apply auto[1] - apply (metis \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) + 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\ + 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 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) + 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] - by (metis (no_types, hide_lams) contra_subsetD finite_set_in insert_before_list_in_set - node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' + by (metis (no_types, hide_lams) contra_subsetD finite_set_in insert_before_list_in_set + node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2) then show ?thesis using \a_all_ptrs_in_heap h3\ - apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def + apply(auto simp add: object_ptr_kinds_M_eq3_h' a_all_ptrs_in_heap_def node_ptr_kinds_def node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1] using children_eq_h3 children_h' apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD) - by (metis (no_types) \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) + 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" - proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2 + proof(auto simp add: a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2 children_eq2_h2 intro!: distinct_concat_map_I)[1] fix x assume 1: "x |\| document_ptr_kinds h3" - and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + and 2: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" show "distinct |h3 \ get_disconnected_nodes x|\<^sub>r" - using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3] + using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3] disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1 by (metis (full_types) distinct_remove1 finite_fset fmember.rep_eq set_sorted_list_of_set) - next + next fix x y xa - assume 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume 1: "distinct (concat (map (\document_ptr. |h2 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and 2: "x |\| document_ptr_kinds h3" and 3: "y |\| document_ptr_kinds h3" @@ -5325,8 +5465,8 @@ proof - case True then have "y \ owner_document" using 4 by simp - show ?thesis - using distinct_concat_map_E(1)[OF 1] + show ?thesis + using distinct_concat_map_E(1)[OF 1] using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3] select_result_I2[OF disconnected_nodes_h2] apply(auto simp add: True disconnected_nodes_eq2_h2[OF \y \ owner_document\])[1] by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal notin_set_remove1) @@ -5335,17 +5475,17 @@ proof - then show ?thesis proof (cases "y = owner_document") case True - then show ?thesis - using distinct_concat_map_E(1)[OF 1] + then show ?thesis + using distinct_concat_map_E(1)[OF 1] using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3] select_result_I2[OF disconnected_nodes_h2] apply(auto simp add: True disconnected_nodes_eq2_h2[OF \x \ owner_document\])[1] by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal notin_set_remove1) next case False - then show ?thesis + then show ?thesis using distinct_concat_map_E(1)[OF 1, simplified, OF 2 3 4] 5 6 - using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 - disjoint_iff_not_equal finite_fset fmember.rep_eq notin_set_remove1 select_result_I2 + using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 + disjoint_iff_not_equal finite_fset fmember.rep_eq notin_set_remove1 select_result_I2 set_sorted_list_of_set by (metis (no_types, lifting)) qed @@ -5360,15 +5500,15 @@ proof - and 5: "x \ set |h3 \ get_disconnected_nodes xb|\<^sub>r" have 6: "set |h3 \ get_child_nodes xa|\<^sub>r \ set |h2 \ get_disconnected_nodes xb|\<^sub>r = {}" using 1 2 4 - by (metis \type_wf h2\ children_eq2_h2 document_ptr_kinds_commutes known_ptrs - local.get_child_nodes_ok local.get_disconnected_nodes_ok - local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr - object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result + by (metis \type_wf h2\ children_eq2_h2 document_ptr_kinds_commutes known_ptrs + local.get_child_nodes_ok local.get_disconnected_nodes_ok + local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr + object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result wellformed_h2) show False proof (cases "xb = owner_document") case True - then show ?thesis + then show ?thesis using select_result_I2[OF disconnected_nodes_h3,folded select_result_I2[OF disconnected_nodes_h2]] by (metis (no_types, lifting) "3" "5" "6" disjoint_iff_not_equal notin_set_remove1) next @@ -5378,7 +5518,7 @@ proof - qed qed then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3 + proof(auto simp add: a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3 disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)[1] fix x assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) @@ -5390,17 +5530,17 @@ proof - proof(cases "ptr = x") case True show ?thesis - using 3[OF 2] children_h3 children_h' - by(auto simp add: True insert_before_list_distinct + using 3[OF 2] children_h3 children_h' + by(auto simp add: True insert_before_list_distinct dest: child_not_in_any_children[unfolded children_eq_h2]) next case False - show ?thesis + show ?thesis using children_eq2_h3[OF False] 3[OF 2] by auto qed next fix x y xa - assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) + assume 1: "distinct (concat (map (\ptr. |h3 \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h')))))" and 2: "x |\| object_ptr_kinds h'" and 3: "y |\| object_ptr_kinds h'" @@ -5417,16 +5557,16 @@ proof - then show ?thesis using children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6 apply(auto simp add: True children_eq2_h3[OF \ptr \ y\])[1] - by (metis (no_types, hide_lams) "3" "7" \type_wf h3\ children_eq2_h3 disjoint_iff_not_equal - get_child_nodes_ok insert_before_list_in_set known_ptrs local.known_ptrs_known_ptr - object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' + by (metis (no_types, hide_lams) "3" "7" \type_wf h3\ children_eq2_h3 disjoint_iff_not_equal + get_child_nodes_ok insert_before_list_in_set known_ptrs local.known_ptrs_known_ptr + object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2 returns_result_select_result select_result_I2) next case False then show ?thesis proof (cases "ptr = y") case True - then show ?thesis + then show ?thesis using children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6 apply(auto simp add: True children_eq2_h3[OF \ptr \ x\])[1] by (metis (no_types, hide_lams) "2" "4" "7" IntI \known_ptrs h3\ \type_wf h'\ @@ -5441,7 +5581,7 @@ proof - qed next fix x xa xb - assume 1: " (\x\fset (object_ptr_kinds h'). set |h3 \ get_child_nodes x|\<^sub>r) + assume 1: " (\x\fset (object_ptr_kinds h'). set |h3 \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h'). set |h' \ get_disconnected_nodes x|\<^sub>r) = {} " and 2: "xa |\| object_ptr_kinds h'" and 3: "x \ set |h' \ get_child_nodes xa|\<^sub>r" @@ -5457,7 +5597,7 @@ proof - then have f1: "h3 \ get_disconnected_nodes xb \\<^sub>r |h' \ get_disconnected_nodes xb|\<^sub>r" by (simp add: disconnected_nodes_eq_h3) have "xa |\| object_ptr_kinds h3" - using "2" object_ptr_kinds_M_eq3_h' by blast + using "2" object_ptr_kinds_M_eq3_h' by blast then show ?thesis using f1 \local.a_distinct_lists h3\ local.distinct_lists_no_parent by fastforce qed @@ -5465,17 +5605,17 @@ proof - proof (cases "ptr = xa") case True show ?thesis - using 6 node_not_in_disconnected_nodes 3 4 5 select_result_I2[OF children_h'] + using 6 node_not_in_disconnected_nodes 3 4 5 select_result_I2[OF children_h'] select_result_I2[OF children_h3] True disconnected_nodes_eq2_h3 - by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M - \a_distinct_lists h3\ \type_wf h'\ disconnected_nodes_eq_h3 - distinct_lists_no_parent document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok + by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M + \a_distinct_lists h3\ \type_wf h'\ disconnected_nodes_eq_h3 + distinct_lists_no_parent document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok insert_before_list_in_set object_ptr_kinds_M_eq3_h' returns_result_select_result) next case False then show ?thesis - using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce + using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce qed qed @@ -5483,44 +5623,46 @@ proof - using wellformed_h2 by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" apply(auto simp add: a_owner_document_valid_def object_ptr_kinds_M_eq2_h2 - object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 + object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3 children_eq2_h2)[1] - apply(auto simp add: document_ptr_kinds_eq2_h2[simplified] document_ptr_kinds_eq2_h3[simplified] - object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified] + apply(auto simp add: document_ptr_kinds_eq2_h2[simplified] document_ptr_kinds_eq2_h3[simplified] + object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified] node_ptr_kinds_eq2_h2[simplified] node_ptr_kinds_eq2_h3[simplified])[1] apply(auto simp add: disconnected_nodes_eq2_h3[symmetric])[1] - by (smt children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set object_ptr_kinds_M_eq3_h' ptr_in_heap select_result_I2) + by (smt children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2 + disconnected_nodes_h3 finite_set_in in_set_remove1 insert_before_list_in_set + object_ptr_kinds_M_eq3_h' ptr_in_heap select_result_I2) ultimately show "heap_is_wellformed h'" by (simp add: heap_is_wellformed_def) qed end -locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs - + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs + - assumes insert_before_preserves_type_wf: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' +locale l_insert_before_wf2 = l_type_wf + l_known_ptrs + l_insert_before_defs + + l_heap_is_wellformed_defs + l_get_child_nodes_defs + l_remove_defs + + assumes insert_before_preserves_type_wf: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' \ type_wf h'" - assumes insert_before_preserves_known_ptrs: - "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' + assumes insert_before_preserves_known_ptrs: + "heap_is_wellformed h \ type_wf h \ known_ptrs h \ h \ insert_before ptr child ref \\<^sub>h h' \ known_ptrs h'" assumes insert_before_heap_is_wellformed_preserved: "type_wf h \ known_ptrs h \ heap_is_wellformed h \ h \ insert_before ptr child ref \\<^sub>h h' \ heap_is_wellformed h'" -interpretation i_insert_before_wf2?: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs - get_child_nodes get_child_nodes_locs set_child_nodes - set_child_nodes_locs get_ancestors get_ancestors_locs - adopt_node adopt_node_locs set_disconnected_nodes - set_disconnected_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs get_owner_document insert_before - insert_before_locs append_child type_wf known_ptr known_ptrs - heap_is_wellformed parent_child_rel remove_child - remove_child_locs get_root_node get_root_node_locs +interpretation i_insert_before_wf2?: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs + get_child_nodes get_child_nodes_locs set_child_nodes + set_child_nodes_locs get_ancestors get_ancestors_locs + adopt_node adopt_node_locs set_disconnected_nodes + set_disconnected_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs get_owner_document insert_before + insert_before_locs append_child type_wf known_ptr known_ptrs + heap_is_wellformed parent_child_rel remove_child + remove_child_locs get_root_node get_root_node_locs by(simp add: l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) declare l_insert_before_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] -lemma insert_before_wf2_is_l_insert_before_wf2 [instances]: +lemma insert_before_wf2_is_l_insert_before_wf2 [instances]: "l_insert_before_wf2 type_wf known_ptr known_ptrs insert_before heap_is_wellformed" apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1] using insert_before_heap_is_wellformed_preserved apply(fast, fast, fast) @@ -5543,7 +5685,8 @@ lemma append_child_heap_is_wellformed_preserved: 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) + 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" @@ -5562,21 +5705,21 @@ proof - h3: "h2 \ set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \\<^sub>h h3" and h': "h3 \ a_insert_node ptr node None \\<^sub>h h'" using assms(5) - by(auto simp add: append_child_def insert_before_def a_ensure_pre_insertion_validity_def - elim!: bind_returns_heap_E bind_returns_result_E - bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] - bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] - bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] - bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] - bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] - split: if_splits option.splits) + by(auto simp add: append_child_def insert_before_def a_ensure_pre_insertion_validity_def + elim!: bind_returns_heap_E bind_returns_result_E + bind_returns_heap_E2[rotated, OF get_parent_pure, rotated] + bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] + bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated] + bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated] + bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated] + split: if_splits option.splits) have "\parent. |h \ get_parent node|\<^sub>r = Some parent \ parent \ ptr" using assms(1) assms(4) assms(6) - by (metis (no_types, lifting) assms(2) assms(3) h2 is_OK_returns_heap_I is_OK_returns_result_E - local.adopt_node_child_in_heap local.get_parent_child_dual local.get_parent_ok - select_result_I2) + by (metis (no_types, lifting) assms(2) assms(3) h2 is_OK_returns_heap_I is_OK_returns_result_E + local.adopt_node_child_in_heap local.get_parent_child_dual local.get_parent_ok + select_result_I2) have "h2 \ get_child_nodes ptr \\<^sub>r xs" using get_child_nodes_reads adopt_node_writes h2 assms(4) apply(rule reads_writes_separate_forwards) @@ -5603,14 +5746,14 @@ proof - 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 + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) show "h' \ get_child_nodes ptr \\<^sub>r xs@[node]" - using h' - apply(auto simp add: a_insert_node_def - dest!: bind_returns_heap_E3[rotated, OF \h3 \ get_child_nodes ptr \\<^sub>r xs\ - get_child_nodes_pure, rotated])[1] + using h' + apply(auto simp add: a_insert_node_def + dest!: bind_returns_heap_E3[rotated, OF \h3 \ get_child_nodes ptr \\<^sub>r xs\ + get_child_nodes_pure, rotated])[1] using \type_wf h3\ set_child_nodes_get_child_nodes \known_ptr ptr\ by metis qed @@ -5624,10 +5767,10 @@ lemma append_child_for_all_on_children: shows "h' \ get_child_nodes ptr \\<^sub>r xs@nodes" using assms apply(induct nodes arbitrary: h xs) - apply(simp) + apply(simp) proof(auto elim!: bind_returns_heap_E)[1]fix a nodes h xs h'a - assume 0: "(\h xs. heap_is_wellformed h \ type_wf h \ known_ptrs h - \ h \ get_child_nodes ptr \\<^sub>r xs \ h \ forall_M (append_child ptr) nodes \\<^sub>h h' + assume 0: "(\h xs. heap_is_wellformed h \ type_wf h \ known_ptrs h + \ h \ get_child_nodes ptr \\<^sub>r xs \ h \ forall_M (append_child ptr) nodes \\<^sub>h h' \ set nodes \ set xs = {} \ h' \ get_child_nodes ptr \\<^sub>r xs @ nodes)" and 1: "heap_is_wellformed h" and 2: "type_wf h" @@ -5645,8 +5788,8 @@ proof(auto elim!: bind_returns_heap_E)[1]fix a nodes h xs h'a using "1" "2" "3" "4" "8" by blast moreover have "heap_is_wellformed h'a" and "type_wf h'a" and "known_ptrs h'a" - using insert_before_heap_is_wellformed_preserved insert_before_preserves_known_ptrs - insert_before_preserves_type_wf 1 2 3 6 append_child_def + using insert_before_heap_is_wellformed_preserved insert_before_preserves_known_ptrs + insert_before_preserves_type_wf 1 2 3 6 append_child_def by metis+ moreover have "set nodes \ set (xs @ [a]) = {}" using 9 10 @@ -5668,28 +5811,29 @@ lemma append_child_for_all_on_no_children: 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' + 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' + 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 - set_disconnected_nodes set_disconnected_nodes_locs - adopt_node adopt_node_locs known_ptr type_wf get_child_nodes - get_child_nodes_locs known_ptrs set_child_nodes - set_child_nodes_locs remove get_ancestors get_ancestors_locs - insert_before insert_before_locs append_child heap_is_wellformed - parent_child_rel +interpretation i_append_child_wf?: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent + get_parent_locs remove_child remove_child_locs + get_disconnected_nodes get_disconnected_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs + adopt_node adopt_node_locs known_ptr type_wf get_child_nodes + get_child_nodes_locs known_ptrs set_child_nodes + set_child_nodes_locs remove get_ancestors get_ancestors_locs + insert_before insert_before_locs append_child heap_is_wellformed + parent_child_rel by(auto simp add: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances) -lemma append_child_wf_is_l_append_child_wf [instances]: "l_append_child_wf type_wf known_ptr known_ptrs append_child heap_is_wellformed" +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+ @@ -5697,38 +5841,38 @@ lemma append_child_wf_is_l_append_child_wf [instances]: "l_append_child_wf type_ subsection \create\_element\ locale l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = - l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs - get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel + + l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes get_child_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel + l_new_element_get_disconnected_nodes get_disconnected_nodes get_disconnected_nodes_locs + l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs - get_disconnected_nodes get_disconnected_nodes_locs + - l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr + + get_disconnected_nodes get_disconnected_nodes_locs + + l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr + l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr - get_child_nodes get_child_nodes_locs + - l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs - get_child_nodes get_child_nodes_locs + + get_child_nodes get_child_nodes_locs + + l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs + get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs + - l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes - get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + + l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes + get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + l_new_element type_wf + l_known_ptrs known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and known_ptrs :: "(_) heap \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" + and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_tag_name :: "(_) element_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_tag_name_locs :: "(_) element_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_element :: "(_) document_ptr \ char list \ ((_) heap, exception, (_) element_ptr) prog" begin lemma create_element_preserves_wellformedness: assumes "heap_is_wellformed h" @@ -5743,19 +5887,20 @@ proof - h3: "h2 \ set_tag_name 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'" - using assms(2) + using assms(2) by(auto simp add: create_element_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + 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) + 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 - using new_element_ptr_not_in_heap by blast + using new_element_ptr_not_in_heap by blast then have "cast new_element_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r" by simp then have "cast new_element_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r" @@ -5777,18 +5922,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", OF set_tag_name_writes h3]) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_tag_name_writes h3]) using set_tag_name_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -5798,7 +5944,8 @@ proof - 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 + 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 @@ -5812,47 +5959,47 @@ proof - have "document_ptr |\| document_ptr_kinds h" - using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_element_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_element_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h2 get_child_nodes_new_element[rotated, OF new_element_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: "\ptr'. ptr' \ cast new_element_ptr + then have children_eq2_h: "\ptr'. ptr' \ cast new_element_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes (cast new_element_ptr) \\<^sub>r []" - using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr] - new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes + using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr] + new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" using get_disconnected_nodes_reads h2 get_disconnected_nodes_new_element[OF new_element_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have disconnected_nodes_eq2_h: + then have disconnected_nodes_eq2_h: "\doc_ptr. |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - have children_eq_h2: + 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_tag_name_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_tag_name_get_child_nodes) then have children_eq2_h2: "\ptr'. |h2 \ get_child_nodes ptr'|\<^sub>r = |h3 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. 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_tag_name_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_tag_name_get_disconnected_nodes) - then have disconnected_nodes_eq2_h2: + then have disconnected_nodes_eq2_h2: "\doc_ptr. |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force @@ -5864,40 +6011,40 @@ proof - by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) - have children_eq_h3: + have children_eq_h3: "\ptr' children. h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_child_nodes) then have children_eq2_h3: "\ptr'. |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h3: - "\doc_ptr disc_nodes. document_ptr \ doc_ptr - \ h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: - "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: + "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h2 disc_nodes_h3 by auto then have disc_nodes_document_ptr_h: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h by auto then have "cast new_element_ptr \ set disc_nodes_h3" - using \heap_is_wellformed h\ - using \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 + 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 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\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h2" proof(auto simp add: parent_child_rel_def)[1] @@ -5911,12 +6058,12 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h2 \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.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>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) + by (metis ObjectMonad.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>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) next fix a x assume 0: "a |\| object_ptr_kinds h2" - and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq_h \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 []\ by(auto) @@ -5925,9 +6072,9 @@ proof - assume 0: "a |\| object_ptr_kinds h2" and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) - \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_h empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) + \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_h empty_iff empty_set image_eqI select_result_I2) qed also have "\ = parent_child_rel h3" by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2) @@ -5940,69 +6087,81 @@ 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] - 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) + 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 (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) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - by (smt \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)) + 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\ - heap_is_wellformed_children_in_heap - by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp - fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) + 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\ + heap_is_wellformed_children_in_heap + by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp + fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) then have "\p. p |\| object_ptr_kinds h2 \ cast new_element_ptr \ set |h2 \ get_child_nodes p|\<^sub>r" using children_eq2_h apply(auto simp add: object_ptr_kinds_eq_h)[1] using \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 []\ apply auto[1] - by (metis ObjectMonad.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>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\) + by (metis ObjectMonad.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>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\) then have "\p. p |\| object_ptr_kinds h3 \ cast new_element_ptr \ set |h3 \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h2 children_eq2_h2 by auto - then have new_element_ptr_not_in_any_children: + then have new_element_ptr_not_in_any_children: "\p. p |\| object_ptr_kinds h' \ cast new_element_ptr \ set |h' \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h3 children_eq2_h3 by auto have "a_distinct_lists h" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h2" using \h2 \ get_child_nodes (cast new_element_ptr) \\<^sub>r []\ - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) apply(case_tac "x=cast new_element_ptr") apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok + apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result) apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h + by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result) - + then have "a_distinct_lists h3" - by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 - children_eq2_h2 object_ptr_kinds_eq_h2) + by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + children_eq2_h2 object_ptr_kinds_eq_h2) then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 - object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 - intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 + object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 + intro!: distinct_concat_map_I)[1] fix x - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h' set_disconnected_nodes_get_disconnected_nodes - by (metis (no_types, lifting) \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 disc_nodes_h3\ - \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) - distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) \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 disc_nodes_h3\ + \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) + distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq + returns_result_select_result) next fix x y xa - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" and "y |\| document_ptr_kinds h3" @@ -6014,37 +6173,40 @@ proof - ultimately show "False" apply(-) apply(cases "x = document_ptr") - 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) + 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) + assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h3). set |h3 \ get_disconnected_nodes x|\<^sub>r) = {}" and 3: "xa |\| object_ptr_kinds h3" and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" and 5: "xb |\| document_ptr_kinds h3" and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" - show "False" + show "False" using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3 apply - apply(cases "xb = document_ptr") - apply (metis (no_types, hide_lams) "3" "4" "6" - \\p. p |\| object_ptr_kinds h3 - \ 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 |h3 \ get_child_nodes p|\<^sub>r\ - \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' - select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) - by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 - distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) + apply (metis (no_types, hide_lams) "3" "4" "6" + \\p. p |\| object_ptr_kinds h3 + \ 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 |h3 \ get_child_nodes p|\<^sub>r\ + \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' + select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) + by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 + distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) qed have "a_owner_document_valid h" @@ -6058,13 +6220,19 @@ proof - apply(auto simp add: document_ptr_kinds_eq_h2)[1] apply(auto simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )[1] apply(auto simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )[1] - apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] - disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 + apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] + disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] - apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) - local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) + apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) apply(simp add: object_ptr_kinds_eq_h) - by(metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M \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) + 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'\ @@ -6072,11 +6240,11 @@ proof - qed end -interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf - get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel - set_tag_name set_tag_name_locs - set_disconnected_nodes set_disconnected_nodes_locs create_element +interpretation i_create_element_wf?: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf + get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + set_tag_name set_tag_name_locs + set_disconnected_nodes set_disconnected_nodes_locs create_element using instances by(auto simp add: l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] @@ -6086,46 +6254,46 @@ subsection \create\_character\_data\ locale l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + l_new_character_data_get_disconnected_nodes - get_disconnected_nodes get_disconnected_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_set_val_get_disconnected_nodes - type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs + l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs set_val set_val_locs type_wf create_character_data known_ptr + 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 + type_wf known_ptr get_child_nodes get_child_nodes_locs + l_set_val_get_child_nodes - type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs + type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes_get_child_nodes - set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs + l_set_disconnected_nodes - type_wf set_disconnected_nodes set_disconnected_nodes_locs + type_wf set_disconnected_nodes set_disconnected_nodes_locs + l_set_disconnected_nodes_get_disconnected_nodes - type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes - set_disconnected_nodes_locs + type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes + set_disconnected_nodes_locs + l_new_character_data - type_wf + type_wf + l_known_ptrs - known_ptr known_ptrs + known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: - "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_character_data :: - "(_) document_ptr \ char list \ ((_) heap, exception, (_) character_data_ptr) prog" - and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: + "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_character_data :: + "(_) document_ptr \ char list \ ((_) heap, exception, (_) character_data_ptr) prog" + and known_ptrs :: "(_) heap \ bool" begin lemma create_character_data_preserves_wellformedness: @@ -6141,20 +6309,21 @@ proof - 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'" - using assms(2) - by(auto simp add: create_character_data_def - elim!: bind_returns_heap_E - bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) + using assms(2) + by(auto simp add: create_character_data_def + elim!: bind_returns_heap_E + bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] ) then have "h \ 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)[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) + 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" using new_character_data_ptr CharacterDataMonad.ptr_kinds_ptr_kinds_M h2 - using new_character_data_ptr_not_in_heap by blast + using new_character_data_ptr_not_in_heap by blast then have "cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r" by simp then have "cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r" @@ -6162,14 +6331,14 @@ proof - - have object_ptr_kinds_eq_h: + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" using new_character_data_new_ptr h2 new_character_data_ptr by blast - then have node_ptr_kinds_eq_h: + then have node_ptr_kinds_eq_h: "node_ptr_kinds h2 = node_ptr_kinds h |\| {|cast new_character_data_ptr|}" apply(simp add: node_ptr_kinds_def) by force - then have character_data_ptr_kinds_eq_h: + then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\| {|new_character_data_ptr|}" apply(simp add: character_data_ptr_kinds_def) by force @@ -6181,19 +6350,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_val_writes h3]) + 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) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -6203,7 +6372,8 @@ proof - by(auto simp add: node_ptr_kinds_def) 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 + 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 @@ -6216,27 +6386,27 @@ proof - 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 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h2 get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: - "\ptr'. ptr' \ cast new_character_data_ptr + then have children_eq2_h: + "\ptr'. ptr' \ cast new_character_data_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have object_ptr_kinds_eq_h: + have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\| {|cast new_character_data_ptr|}" using new_character_data_new_ptr h2 new_character_data_ptr by blast - then have node_ptr_kinds_eq_h: + then have node_ptr_kinds_eq_h: "node_ptr_kinds h2 = node_ptr_kinds h |\| {|cast new_character_data_ptr|}" apply(simp add: node_ptr_kinds_def) by force - then have character_data_ptr_kinds_eq_h: + then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\| {|new_character_data_ptr|}" apply(simp add: character_data_ptr_kinds_def) by force @@ -6248,19 +6418,19 @@ proof - by(auto simp add: document_ptr_kinds_def) have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_val_writes h3]) + 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) then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2" by (auto simp add: document_ptr_kinds_def) have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2" - using object_ptr_kinds_eq_h2 + using object_ptr_kinds_eq_h2 by(auto simp add: node_ptr_kinds_def) have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3" - apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", - OF set_disconnected_nodes_writes h']) + apply(rule writes_small_big[where P="\h h'. object_ptr_kinds h' = object_ptr_kinds h", + OF set_disconnected_nodes_writes h']) using set_disconnected_nodes_pointers_preserved by (auto simp add: reflp_def transp_def) then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3" @@ -6271,50 +6441,50 @@ proof - have "document_ptr |\| document_ptr_kinds h" - using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 - get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def + using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2 + get_disconnected_nodes_ptr_in_heap \type_wf h\ document_ptr_kinds_def by (metis is_OK_returns_result_I) - have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr + have children_eq_h: "\(ptr'::(_) object_ptr) children. ptr' \ cast new_character_data_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h2 \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h2 get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2_h: "\ptr'. ptr' \ cast new_character_data_ptr + then have children_eq2_h: "\ptr'. ptr' \ cast new_character_data_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h2 \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []" - using new_character_data_ptr h2 new_character_data_ptr_in_heap[OF h2 new_character_data_ptr] - new_character_data_is_character_data_ptr[OF new_character_data_ptr] - new_character_data_no_child_nodes + using new_character_data_ptr h2 new_character_data_ptr_in_heap[OF h2 new_character_data_ptr] + new_character_data_is_character_data_ptr[OF new_character_data_ptr] + new_character_data_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" - using get_disconnected_nodes_reads h2 - get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2] + using get_disconnected_nodes_reads h2 + get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have disconnected_nodes_eq2_h: + then have disconnected_nodes_eq2_h: "\doc_ptr. |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force - have children_eq_h2: + 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_val_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_val_get_child_nodes) - then have children_eq2_h2: + 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 disconnected_nodes_eq_h2: - "\doc_ptr disc_nodes. h2 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + have disconnected_nodes_eq_h2: + "\doc_ptr disc_nodes. 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_val_writes h3 apply(rule reads_writes_preserved) by(auto simp add: set_val_get_disconnected_nodes) - then have disconnected_nodes_eq2_h2: + then have disconnected_nodes_eq2_h2: "\doc_ptr. |h2 \ get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force @@ -6322,42 +6492,42 @@ proof - using \type_wf h\ new_character_data_types_preserved h2 by blast then have "type_wf h3" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_val_writes h3] - using set_val_types_preserved + using set_val_types_preserved by(auto simp add: reflp_def transp_def) then show "type_wf h'" using writes_small_big[where P="\h h'. type_wf h \ type_wf h'", OF set_disconnected_nodes_writes h'] - using set_disconnected_nodes_types_preserved + using set_disconnected_nodes_types_preserved by(auto simp add: reflp_def transp_def) - have children_eq_h3: + have children_eq_h3: "\ptr' children. h3 \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_child_nodes) - then have children_eq2_h3: + then have children_eq2_h3: " \ptr'. |h3 \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force - have disconnected_nodes_eq_h3: "\doc_ptr disc_nodes. document_ptr \ doc_ptr - \ h3 \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes + 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" using get_disconnected_nodes_reads set_disconnected_nodes_writes h' apply(rule reads_writes_preserved) by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers) - then have disconnected_nodes_eq2_h3: "\doc_ptr. document_ptr \ doc_ptr + then have disconnected_nodes_eq2_h3: "\doc_ptr. document_ptr \ 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 disc_nodes_document_ptr_h2: "h2 \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h2 disc_nodes_h3 by auto then have disc_nodes_document_ptr_h: "h \ get_disconnected_nodes document_ptr \\<^sub>r disc_nodes_h3" using disconnected_nodes_eq_h by auto then have "cast new_character_data_ptr \ set disc_nodes_h3" using \heap_is_wellformed h\ using \cast new_character_data_ptr \ set |h \ node_ptr_kinds_M|\<^sub>r\ - a_all_ptrs_in_heap_def heap_is_wellformed_def + a_all_ptrs_in_heap_def heap_is_wellformed_def using NodeMonad.ptr_kinds_ptr_kinds_M local.heap_is_wellformed_disc_nodes_in_heap by blast have "acyclic (parent_child_rel h)" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h2" proof(auto simp add: parent_child_rel_def)[1] @@ -6371,12 +6541,12 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h2 \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M - \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2_h) + by (metis ObjectMonad.ptr_kinds_ptr_kinds_M + \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2_h) next fix a x assume 0: "a |\| object_ptr_kinds h2" - and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq_h \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ by(auto) @@ -6385,8 +6555,8 @@ proof - assume 0: "a |\| object_ptr_kinds h2" and 1: "x \ set |h2 \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ - children_eq2_h empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ + children_eq2_h empty_iff empty_set image_eqI select_result_I2) qed also have "\ = parent_child_rel h3" by(auto simp add: parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2) @@ -6399,30 +6569,30 @@ 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_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, 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) + 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, 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 (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) + by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + local.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2) then have "a_all_ptrs_in_heap h'" - by (smt character_data_ptr_kinds_commutes children_eq2_h3 disc_nodes_document_ptr_h2 - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 - finite_set_in h' h2 local.a_all_ptrs_in_heap_def - local.set_disconnected_nodes_get_disconnected_nodes new_character_data_ptr - new_character_data_ptr_in_heap node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 - object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1)) + 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 - by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp - fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) + heap_is_wellformed_children_in_heap + by (meson NodeMonad.ptr_kinds_ptr_kinds_M a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp + fset_of_list_elem get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result) then have "\p. p |\| object_ptr_kinds h2 \ cast new_character_data_ptr \ set |h2 \ get_child_nodes p|\<^sub>r" using children_eq2_h apply(auto simp add: object_ptr_kinds_eq_h)[1] @@ -6430,44 +6600,44 @@ proof - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M \cast new_character_data_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\) then have "\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h2 children_eq2_h2 by auto - then have new_character_data_ptr_not_in_any_children: + then have new_character_data_ptr_not_in_any_children: "\p. p |\| object_ptr_kinds h' \ cast new_character_data_ptr \ set |h' \ get_child_nodes p|\<^sub>r" using object_ptr_kinds_eq_h3 children_eq2_h3 by auto have "a_distinct_lists h" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h2" using \h2 \ get_child_nodes (cast new_character_data_ptr) \\<^sub>r []\ - apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h + apply(auto simp add: a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) apply(case_tac "x=cast new_character_data_ptr") apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok - local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr + apply (metis IntI assms(1) assms(3) assms(4) empty_iff local.get_child_nodes_ok + local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result) apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1] - by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h + by (metis \local.a_distinct_lists h\ \type_wf h2\ disconnected_nodes_eq_h document_ptr_kinds_eq_h local.distinct_lists_no_parent local.get_disconnected_nodes_ok returns_result_select_result) then have "a_distinct_lists h3" - by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 - children_eq2_h2 object_ptr_kinds_eq_h2)[1] + by(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2 + children_eq2_h2 object_ptr_kinds_eq_h2)[1] then have "a_distinct_lists h'" - proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 - object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1] + proof(auto simp add: a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3 + object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1] fix x - assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) + assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h3)))))" and "x |\| document_ptr_kinds h3" then show "distinct |h' \ get_disconnected_nodes x|\<^sub>r" using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h' set_disconnected_nodes_get_disconnected_nodes - by (metis (no_types, lifting) \cast new_character_data_ptr \ set disc_nodes_h3\ - \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) - distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq - returns_result_select_result) + by (metis (no_types, lifting) \cast new_character_data_ptr \ set disc_nodes_h3\ + \a_distinct_lists h3\ \type_wf h'\ disc_nodes_h3 distinct.simps(2) + distinct_lists_disconnected_nodes get_disconnected_nodes_ok returns_result_eq + returns_result_select_result) next fix x y xa assume "distinct (concat (map (\document_ptr. |h3 \ get_disconnected_nodes document_ptr|\<^sub>r) @@ -6480,16 +6650,16 @@ 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" - 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) + 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) + assume 2: "(\x\fset (object_ptr_kinds h3). set |h' \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h3). set |h3 \ get_disconnected_nodes x|\<^sub>r) = {}" and 3: "xa |\| object_ptr_kinds h3" and 4: "x \ set |h' \ get_child_nodes xa|\<^sub>r" @@ -6499,11 +6669,11 @@ proof - using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3 apply(cases "xb = document_ptr") apply (metis (no_types, hide_lams) "3" "4" "6" - \\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r\ - \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' - select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) - by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 - distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) + \\p. p |\| object_ptr_kinds h3 \ cast new_character_data_ptr \ set |h3 \ get_child_nodes p|\<^sub>r\ + \a_distinct_lists h3\ children_eq2_h3 disc_nodes_h3 distinct_lists_no_parent h' + select_result_I2 set_ConsD set_disconnected_nodes_get_disconnected_nodes) + by (metis "3" "4" "5" "6" \a_distinct_lists h3\ \type_wf h3\ children_eq2_h3 + distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result) qed have "a_owner_document_valid h" @@ -6517,17 +6687,17 @@ proof - apply(simp add: document_ptr_kinds_eq_h2) apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 ) apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h ) - apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] disconnected_nodes_eq2_h - disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] - apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) - local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) + apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric] disconnected_nodes_eq2_h + disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1] + apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1) + local.set_disconnected_nodes_get_disconnected_nodes select_result_I2) apply(simp add: object_ptr_kinds_eq_h) - by (metis (mono_tags, lifting) \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) + 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) show "heap_is_wellformed h'" @@ -6536,10 +6706,10 @@ proof - qed end -interpretation i_create_character_data_wf?: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf - get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs - heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes - set_disconnected_nodes_locs create_character_data known_ptrs +interpretation i_create_character_data_wf?: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf + get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs + heap_is_wellformed parent_child_rel set_val set_val_locs set_disconnected_nodes + set_disconnected_nodes_locs create_character_data known_ptrs using instances by (auto simp add: l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_character_data_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] @@ -6549,32 +6719,32 @@ subsection \create\_document\ locale l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + l_new_document_get_disconnected_nodes - get_disconnected_nodes get_disconnected_nodes_locs + get_disconnected_nodes get_disconnected_nodes_locs + l_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M - create_document + create_document + l_new_document_get_child_nodes - type_wf known_ptr get_child_nodes get_child_nodes_locs - + l_new_document - type_wf + type_wf known_ptr get_child_nodes get_child_nodes_locs + + l_new_document + type_wf + l_known_ptrs - known_ptr known_ptrs + known_ptr known_ptrs for known_ptr :: "(_::linorder) object_ptr \ bool" - and type_wf :: "(_) heap \ bool" - and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" - and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" - and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" - and heap_is_wellformed :: "(_) heap \ bool" - and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" - and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" - and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" - and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" - and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" - and create_document :: "((_) heap, exception, (_) document_ptr) prog" - and known_ptrs :: "(_) heap \ bool" + and type_wf :: "(_) heap \ bool" + and get_child_nodes :: "(_) object_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_child_nodes_locs :: "(_) object_ptr \ ((_) heap \ (_) heap \ bool) set" + and get_disconnected_nodes :: "(_) document_ptr \ ((_) heap, exception, (_) node_ptr list) prog" + and get_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap \ (_) heap \ bool) set" + and heap_is_wellformed :: "(_) heap \ bool" + and parent_child_rel :: "(_) heap \ ((_) object_ptr \ (_) object_ptr) set" + and set_val :: "(_) character_data_ptr \ char list \ ((_) heap, exception, unit) prog" + and set_val_locs :: "(_) character_data_ptr \ ((_) heap, exception, unit) prog set" + and set_disconnected_nodes :: "(_) document_ptr \ (_) node_ptr list \ ((_) heap, exception, unit) prog" + and set_disconnected_nodes_locs :: "(_) document_ptr \ ((_) heap, exception, unit) prog set" + and create_document :: "((_) heap, exception, (_) document_ptr) prog" + and known_ptrs :: "(_) heap \ bool" begin lemma create_document_preserves_wellformedness: @@ -6587,7 +6757,7 @@ proof - obtain new_document_ptr where new_document_ptr: "h \ new_document \\<^sub>r new_document_ptr" and h': "h \ new_document \\<^sub>h h'" - using assms(2) + using assms(2) apply(simp add: create_document_def) using new_document_ok by blast @@ -6619,30 +6789,30 @@ proof - by (metis (no_types, lifting) document_ptr_kinds_commutes document_ptr_kinds_def finsertI1 fset.map_comp) - have children_eq: - "\(ptr'::(_) object_ptr) children. ptr' \ cast new_document_ptr + have children_eq: + "\(ptr'::(_) object_ptr) children. ptr' \ cast new_document_ptr \ h \ get_child_nodes ptr' \\<^sub>r children = h' \ get_child_nodes ptr' \\<^sub>r children" using get_child_nodes_reads h' get_child_nodes_new_document[rotated, OF new_document_ptr h'] apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] by blast+ - then have children_eq2: "\ptr'. ptr' \ cast new_document_ptr + then have children_eq2: "\ptr'. ptr' \ cast new_document_ptr \ |h \ get_child_nodes ptr'|\<^sub>r = |h' \ get_child_nodes ptr'|\<^sub>r" using select_result_eq by force have "h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []" - using new_document_ptr h' new_document_ptr_in_heap[OF h' new_document_ptr] - new_document_is_document_ptr[OF new_document_ptr] new_document_no_child_nodes + using new_document_ptr h' new_document_ptr_in_heap[OF h' new_document_ptr] + new_document_is_document_ptr[OF new_document_ptr] new_document_no_child_nodes by blast - have disconnected_nodes_eq_h: - "\doc_ptr disc_nodes. doc_ptr \ new_document_ptr + have disconnected_nodes_eq_h: + "\doc_ptr disc_nodes. doc_ptr \ new_document_ptr \ h \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes = h' \ get_disconnected_nodes doc_ptr \\<^sub>r disc_nodes" using get_disconnected_nodes_reads h' get_disconnected_nodes_new_document_different_pointers new_document_ptr apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1] - by (metis(full_types) \\thesis. (\new_document_ptr. - \h \ new_document \\<^sub>r new_document_ptr; h \ new_document \\<^sub>h h'\ \ thesis) \ thesis\ - local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+ - then have disconnected_nodes_eq2_h: "\doc_ptr. doc_ptr \ new_document_ptr + by (metis(full_types) \\thesis. (\new_document_ptr. + \h \ new_document \\<^sub>r new_document_ptr; h \ new_document \\<^sub>h h'\ \ thesis) \ thesis\ + local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+ + then have disconnected_nodes_eq2_h: "\doc_ptr. doc_ptr \ new_document_ptr \ |h \ get_disconnected_nodes doc_ptr|\<^sub>r = |h' \ get_disconnected_nodes doc_ptr|\<^sub>r" using select_result_eq by force have "h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" @@ -6652,7 +6822,7 @@ proof - using \type_wf h\ new_document_types_preserved h' by blast have "acyclic (parent_child_rel h)" - using \heap_is_wellformed h\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def acyclic_heap_def) also have "parent_child_rel h = parent_child_rel h'" proof(auto simp add: parent_child_rel_def)[1] @@ -6666,22 +6836,22 @@ proof - assume 0: "a |\| object_ptr_kinds h" and 1: "x \ set |h \ get_child_nodes a|\<^sub>r" then show "x \ set |h' \ get_child_nodes a|\<^sub>r" - by (metis ObjectMonad.ptr_kinds_ptr_kinds_M - \cast new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2) + by (metis ObjectMonad.ptr_kinds_ptr_kinds_M + \cast new_document_ptr \ set |h \ object_ptr_kinds_M|\<^sub>r\ children_eq2) next fix a x assume 0: "a |\| object_ptr_kinds h'" - and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" + and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" then show "a |\| object_ptr_kinds h" using object_ptr_kinds_eq \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ by(auto) - next + next fix a x assume 0: "a |\| object_ptr_kinds h'" and 1: "x \ set |h' \ get_child_nodes a|\<^sub>r" then show "x \ set |h \ get_child_nodes a|\<^sub>r" - by (metis (no_types, lifting) \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ - children_eq2 empty_iff empty_set image_eqI select_result_I2) + by (metis (no_types, lifting) \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ + children_eq2 empty_iff empty_set image_eqI select_result_I2) qed finally have "a_acyclic_heap h'" by (simp add: acyclic_heap_def) @@ -6690,37 +6860,41 @@ proof - using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_all_ptrs_in_heap h'" apply(auto simp add: a_all_ptrs_in_heap_def)[1] - using ObjectMonad.ptr_kinds_ptr_kinds_M - \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 + 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) + 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\ + using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_distinct_lists h'" - using \h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []\ - \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ + using \h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []\ + \h' \ get_child_nodes (cast new_document_ptr) \\<^sub>r []\ - apply(auto simp add: children_eq2[symmetric] a_distinct_lists_def insort_split object_ptr_kinds_eq - document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] - apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) + apply(auto simp add: children_eq2[symmetric] a_distinct_lists_def insort_split object_ptr_kinds_eq + document_ptr_kinds_eq_h disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1] + apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert) - apply(auto simp add: dest: distinct_concat_map_E)[1] - apply(auto simp add: dest: distinct_concat_map_E)[1] + apply(auto simp add: dest: distinct_concat_map_E)[1] + apply(auto simp add: dest: distinct_concat_map_E)[1] using \new_document_ptr |\| document_ptr_kinds h\ - apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1] + apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1] using disconnected_nodes_eq_h - apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.get_disconnected_nodes_ok - local.heap_is_wellformed_disconnected_nodes_distinct - returns_result_select_result) + apply (metis assms(1) assms(3) disconnected_nodes_eq2_h local.get_disconnected_nodes_ok + local.heap_is_wellformed_disconnected_nodes_distinct + returns_result_select_result) proof - fix x :: "(_) document_ptr" and y :: "(_) document_ptr" and xa :: "(_) node_ptr" assume a1: "x \ y" @@ -6728,7 +6902,7 @@ proof - assume a3: "x \ new_document_ptr" assume a4: "y |\| document_ptr_kinds h" assume a5: "y \ new_document_ptr" - assume a6: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + assume a6: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h)))))" assume a7: "xa \ set |h' \ get_disconnected_nodes x|\<^sub>r" assume a8: "xa \ set |h' \ get_disconnected_nodes y|\<^sub>r" @@ -6746,11 +6920,11 @@ proof - fix x xa xb assume 0: "h' \ get_disconnected_nodes new_document_ptr \\<^sub>r []" and 1: "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 []" - and 2: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) + and 2: "distinct (concat (map (\ptr. |h \ get_child_nodes ptr|\<^sub>r) (sorted_list_of_set (fset (object_ptr_kinds h)))))" - and 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) + and 3: "distinct (concat (map (\document_ptr. |h \ get_disconnected_nodes document_ptr|\<^sub>r) (sorted_list_of_set (fset (document_ptr_kinds h)))))" - and 4: "(\x\fset (object_ptr_kinds h). set |h \ get_child_nodes x|\<^sub>r) + and 4: "(\x\fset (object_ptr_kinds h). set |h \ get_child_nodes x|\<^sub>r) \ (\x\fset (document_ptr_kinds h). set |h \ get_disconnected_nodes x|\<^sub>r) = {}" and 5: "x \ set |h \ get_child_nodes xa|\<^sub>r" and 6: "x \ set |h' \ get_disconnected_nodes xb|\<^sub>r" @@ -6760,28 +6934,29 @@ proof - and 10: "xb \ new_document_ptr" then show "False" - by (metis \local.a_distinct_lists h\ assms(3) disconnected_nodes_eq2_h - local.distinct_lists_no_parent local.get_disconnected_nodes_ok - returns_result_select_result) + by (metis \local.a_distinct_lists h\ assms(3) disconnected_nodes_eq2_h + local.distinct_lists_no_parent local.get_disconnected_nodes_ok + returns_result_select_result) qed have "a_owner_document_valid h" using \heap_is_wellformed h\ by (simp add: heap_is_wellformed_def) then have "a_owner_document_valid h'" apply(auto simp add: a_owner_document_valid_def)[1] - by (metis \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\ - children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in funion_iff node_ptr_kinds_eq object_ptr_kinds_eq) + 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\ + 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) qed end -interpretation i_create_document_wf?: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes - get_child_nodes_locs get_disconnected_nodes - get_disconnected_nodes_locs heap_is_wellformed parent_child_rel - set_val set_val_locs set_disconnected_nodes - set_disconnected_nodes_locs create_document known_ptrs +interpretation i_create_document_wf?: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes + get_child_nodes_locs get_disconnected_nodes + get_disconnected_nodes_locs heap_is_wellformed parent_child_rel + set_val set_val_locs set_disconnected_nodes + set_disconnected_nodes_locs create_document known_ptrs using instances by (auto simp add: l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def) declare l_create_document_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] diff --git a/Core_DOM/Core_SC_DOM/safely_composable/classes/ElementClass.thy b/Core_DOM/Core_SC_DOM/safely_composable/classes/ElementClass.thy index 662fa72..ddc43d1 100644 --- a/Core_DOM/Core_SC_DOM/safely_composable/classes/ElementClass.thy +++ b/Core_DOM/Core_SC_DOM/safely_composable/classes/ElementClass.thy @@ -23,7 +23,7 @@ * 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 ***********************************************************************************) @@ -34,9 +34,9 @@ theory ElementClass "NodeClass" "ShadowRootPointer" begin -text\The type @{type "DOMString"} is a type synonym for @{type "string"}, define +text\The type @{type "DOMString"} is a type synonym for @{type "string"}, define in \autoref{sec:Core_DOM_Basic_Datatypes}.\ -type_synonym attr_key = DOMString +type_synonym attr_key = DOMString type_synonym attr_value = DOMString type_synonym attrs = "(attr_key, attr_value) fmap" type_synonym tag_name = DOMString @@ -46,36 +46,43 @@ record ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr) RElement child_nodes :: "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr list" attrs :: attrs shadow_root_opt :: "'shadow_root_ptr shadow_root_ptr option" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element = "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_scheme" -register_default_tvars +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node = "(('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Node" -register_default_tvars +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node" -type_synonym +type_synonym ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object - = "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Object" -register_default_tvars + = "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) +RElement_ext + 'Node) Object" +register_default_tvars "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object" type_synonym - ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) heap - = "(('document_ptr, 'shadow_root_ptr) document_ptr + 'object_ptr, 'element_ptr element_ptr + 'character_data_ptr character_data_ptr + 'node_ptr, 'Object, - ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) heap" + ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, + 'Object, 'Node, 'Element) heap + = "(('document_ptr, 'shadow_root_ptr) document_ptr + 'object_ptr, 'element_ptr element_ptr + +'character_data_ptr character_data_ptr + 'node_ptr, 'Object, + ('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" + "('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 - "element_ptr_kinds heap = the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| (ffilter is_element_ptr_kind (node_ptr_kinds heap)))" + "element_ptr_kinds heap = the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| +(ffilter is_element_ptr_kind (node_ptr_kinds heap)))" -lemma element_ptr_kinds_simp [simp]: - "element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = {|element_ptr|} |\| element_ptr_kinds h" +lemma element_ptr_kinds_simp [simp]: + "element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = +{|element_ptr|} |\| element_ptr_kinds h" apply(auto simp add: element_ptr_kinds_def)[1] by force @@ -85,7 +92,8 @@ definition element_ptrs :: "(_) heap \ (_) element_ptr fset" definition 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 :: "(_) Node \ (_) Element option" where - "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 node = (case RNode.more node of Inl element \ Some (RNode.extend (RNode.truncate node) element) | _ \ None)" + "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 node = (case RNode.more node of Inl element \ +Some (RNode.extend (RNode.truncate node) element) | _ \ None)" adhoc_overloading cast 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 abbreviation cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) Object \ (_) Element option" @@ -116,15 +124,15 @@ abbreviation is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr \ cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr \ None" adhoc_overloading is_element_kind is_element_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t -lemma element_ptr_kinds_commutes [simp]: +lemma element_ptr_kinds_commutes [simp]: "cast element_ptr |\| node_ptr_kinds h \ element_ptr |\| element_ptr_kinds h" apply(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)[1] - by (metis (no_types, lifting) element_ptr_casts_commute2 ffmember_filter fimage_eqI - fset.map_comp is_element_ptr_kind_none node_ptr_casts_commute3 + by (metis (no_types, lifting) element_ptr_casts_commute2 ffmember_filter fimage_eqI + fset.map_comp is_element_ptr_kind_none node_ptr_casts_commute3 node_ptr_kinds_commutes node_ptr_kinds_def option.sel option.simps(3)) definition get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) element_ptr \ (_) heap \ (_) Element option" - where + where "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h = Option.bind (get\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast element_ptr) h) cast" adhoc_overloading get get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t @@ -156,16 +164,16 @@ lemma get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf: 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 notin_fset - option.distinct(1)) + option.distinct(1)) end global_interpretation l_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas type_wf by unfold_locales definition put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) element_ptr \ (_) Element \ (_) heap \ (_) heap" - where + where "put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element = put\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast element_ptr) (cast element)" -adhoc_overloading put put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t +adhoc_overloading put put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t lemma put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap: assumes "put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element h = h'" @@ -182,30 +190,30 @@ lemma put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_put_ptrs: -lemma cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inject [simp]: +lemma cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inject [simp]: "cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e x = cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e y \ x = y" apply(simp add: cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def) by (metis (full_types) RNode.surjective old.unit.exhaust) -lemma 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 [simp]: +lemma 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 [simp]: "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 node = None \ \ (\element. cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element = node)" - apply(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + apply(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits)[1] by (metis (full_types) RNode.select_convs(2) RNode.surjective old.unit.exhaust) -lemma 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_some [simp]: +lemma 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_some [simp]: "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 node = Some element \ cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element = node" - by(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def + by(auto simp add: 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_def cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def RObject.extend_def RNode.extend_def split: sum.splits) lemma 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 [simp]: "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 (cast\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e element) = Some element" by simp -lemma get_elment_ptr_simp1 [simp]: +lemma get_elment_ptr_simp1 [simp]: "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr element h) = Some element" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) -lemma get_elment_ptr_simp2 [simp]: - "element_ptr \ element_ptr' +lemma get_elment_ptr_simp2 [simp]: + "element_ptr \ element_ptr' \ get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr' element h) = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h" by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) @@ -217,9 +225,9 @@ abbreviation "create_element_obj tag_name_arg child_nodes_arg attrs_arg shadow_r definition new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) heap \ ((_) element_ptr \ (_) heap)" where - "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = - (let new_element_ptr = element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref - |`| (element_ptrs h))))) + "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = + (let new_element_ptr = element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref + |`| (element_ptrs h))))) in (new_element_ptr, put new_element_ptr (create_element_obj '''' [] fmempty None) h))" @@ -230,7 +238,7 @@ lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap: unfolding new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def using put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap by blast -lemma new_element_ptr_new: +lemma new_element_ptr_new: "element_ptr.Ref (Suc (fMax (finsert 0 (element_ptr.the_ref |`| element_ptrs h)))) |\| element_ptrs h" by (metis Suc_n_not_le_n element_ptr.sel(1) fMax_ge fimage_finsert finsertI1 finsertI2 set_finsert) @@ -293,22 +301,27 @@ definition a_known_ptrs :: "(_) heap \ bool" where "a_known_ptrs h = (\ptr \ fset (object_ptr_kinds h). known_ptr ptr)" -lemma known_ptrs_known_ptr: +lemma known_ptrs_known_ptr: "ptr |\| object_ptr_kinds h \ a_known_ptrs h \ known_ptr ptr" 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'" +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'" +lemma known_ptrs_subset: + "object_ptr_kinds h' |\| object_ptr_kinds h \ a_known_ptrs h \ a_known_ptrs h'" 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'" +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 known_ptrs_subset known_ptrs_new_ptr l_known_ptrs_def 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/Core_SC_DOM/safely_composable/pointers/ShadowRootPointer.thy b/Core_DOM/Core_SC_DOM/safely_composable/pointers/ShadowRootPointer.thy index 38660a2..edf6d0e 100644 --- a/Core_DOM/Core_SC_DOM/safely_composable/pointers/ShadowRootPointer.thy +++ b/Core_DOM/Core_SC_DOM/safely_composable/pointers/ShadowRootPointer.thy @@ -23,31 +23,31 @@ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * + * * SPDX-License-Identifier: BSD-2-Clause ***********************************************************************************) section\ShadowRoot\ -text\In this theory, we introduce the typed pointers for the class ShadowRoot. Note that, in -this document, we will not make use of ShadowRoots nor will we discuss their particular properties. +text\In this theory, we introduce the typed pointers for the class ShadowRoot. Note that, in +this document, we will not make use of ShadowRoots nor will we discuss their particular properties. We only include them here, as they are required for future work and they cannot be added alter -following the object-oriented extensibility of our data model.\ +following the object-oriented extensibility of our data model.\ theory ShadowRootPointer imports "DocumentPointer" begin datatype 'shadow_root_ptr shadow_root_ptr = Ref (the_ref: ref) | Ext 'shadow_root_ptr -register_default_tvars "'shadow_root_ptr shadow_root_ptr" +register_default_tvars "'shadow_root_ptr shadow_root_ptr" type_synonym ('document_ptr, 'shadow_root_ptr) document_ptr = "('shadow_root_ptr shadow_root_ptr + 'document_ptr) document_ptr" -register_default_tvars "('document_ptr, 'shadow_root_ptr) document_ptr" -type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, +register_default_tvars "('document_ptr, 'shadow_root_ptr) document_ptr" +type_synonym ('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr) object_ptr - = "('object_ptr, 'node_ptr, 'element_ptr, + = "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr shadow_root_ptr + 'document_ptr) object_ptr" -register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, - 'document_ptr, 'shadow_root_ptr) object_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" @@ -64,28 +64,29 @@ abbreviation cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub> definition 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>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 :: "(_) document_ptr \ (_) shadow_root_ptr option" where - "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>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 document_ptr = (case document_ptr of document_ptr.Ext (Inl shadow_root_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>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 document_ptr = (case document_ptr of document_ptr.Ext (Inl shadow_root_ptr) \ Some shadow_root_ptr | _ \ None)" abbreviation 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 :: "(_) object_ptr \ (_) shadow_root_ptr option" where - "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case 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 of - Some 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>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 document_ptr + "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case 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 of + Some 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>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 document_ptr | None \ 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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>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>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 consts is_shadow_root_ptr_kind :: 'a definition is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) document_ptr \ bool" where - "is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of Some _ \ True | _ \ False)" + "is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = +(case 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of Some _ \ True | _ \ False)" abbreviation is_shadow_root_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" where - "is_shadow_root_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some document_ptr \ is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr - | None \ False)" + "is_shadow_root_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some document_ptr \ is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr + | None \ False)" adhoc_overloading is_shadow_root_ptr_kind is_shadow_root_ptr_kind\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r lemmas is_shadow_root_ptr_kind_def = is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def @@ -93,44 +94,47 @@ lemmas is_shadow_root_ptr_kind_def = is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^s consts is_shadow_root_ptr :: 'a definition is_shadow_root_ptr\<^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 \ bool" where - "is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of shadow_root_ptr.Ref _ \ True + "is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of shadow_root_ptr.Ref _ \ True | _ \ False)" abbreviation is_shadow_root_ptr\<^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 \ bool" where - "is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some shadow_root_ptr \ is_shadow_root_ptr\<^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 - | _ \ False)" + "is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some shadow_root_ptr \ is_shadow_root_ptr\<^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 + | _ \ False)" abbreviation is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \ bool" where - "is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of - Some document_ptr \ is_shadow_root_ptr\<^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 + "is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ (case cast ptr of + Some document_ptr \ is_shadow_root_ptr\<^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 | None \ False)" -adhoc_overloading is_shadow_root_ptr is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_shadow_root_ptr\<^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 is_shadow_root_ptr is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r + is_shadow_root_ptr\<^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 lemmas is_shadow_root_ptr_def = is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def consts is_shadow_root_ptr_ext :: 'a abbreviation "is_shadow_root_ptr_ext\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ \ is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" -abbreviation "is_shadow_root_ptr_ext\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ is_shadow_root_ptr_kind ptr \ (\ is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)" +abbreviation "is_shadow_root_ptr_ext\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ +is_shadow_root_ptr_kind ptr \ (\ is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)" -abbreviation "is_shadow_root_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ is_shadow_root_ptr_kind ptr \ (\ is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)" +abbreviation "is_shadow_root_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ +is_shadow_root_ptr_kind ptr \ (\ is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)" adhoc_overloading is_shadow_root_ptr_ext is_shadow_root_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_shadow_root_ptr_ext\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r instantiation shadow_root_ptr :: (linorder) linorder begin -definition +definition less_eq_shadow_root_ptr :: "(_::linorder) shadow_root_ptr \ (_) shadow_root_ptr \ bool" - where + where "less_eq_shadow_root_ptr x y \ (case x of Ext i \ (case y of Ext j \ i \ j | Ref _ \ False) | Ref i \ (case y of Ext _ \ True | Ref j \ i \ j))" definition less_shadow_root_ptr :: "(_::linorder) shadow_root_ptr \ (_) shadow_root_ptr \ bool" where "less_shadow_root_ptr x y \ x \ y \ \ y \ x" -instance +instance apply(standard) - by(auto simp add: less_eq_shadow_root_ptr_def less_shadow_root_ptr_def + by(auto simp add: less_eq_shadow_root_ptr_def less_shadow_root_ptr_def split: shadow_root_ptr.splits) end @@ -139,11 +143,12 @@ lemma is_shadow_root_ptr_ref [simp]: "is_shadow_root_ptr (shadow_root_ptr.Ref n) by(simp add: is_shadow_root_ptr\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) lemma shadow_root_ptr_casts_commute [simp]: - "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>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 document_ptr = Some shadow_root_ptr \ cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr = 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>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 document_ptr = +Some shadow_root_ptr \ cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr = document_ptr" unfolding 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by(auto split: document_ptr.splits sum.splits) -lemma shadow_root_ptr_casts_commute2 [simp]: +lemma shadow_root_ptr_casts_commute2 [simp]: "(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>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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr) = Some shadow_root_ptr)" by simp @@ -151,7 +156,7 @@ lemma shadow_root_ptr_casts_commute3 [simp]: assumes "is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr" shows "cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (the (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>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 document_ptr)) = document_ptr" using assms - by(auto simp add: is_shadow_root_ptr_kind_def cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def + by(auto simp add: is_shadow_root_ptr_kind_def cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: document_ptr.splits sum.splits) lemma is_shadow_root_ptr_kind_obtains: @@ -166,19 +171,20 @@ lemma is_shadow_root_ptr_kind_none: unfolding is_shadow_root_ptr_kind_def 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def by(auto split: document_ptr.splits sum.splits) -lemma is_shadow_root_ptr_kind_cast [simp]: +lemma is_shadow_root_ptr_kind_cast [simp]: "is_shadow_root_ptr_kind (cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr)" by (metis shadow_root_ptr_casts_commute is_shadow_root_ptr_kind_none option.distinct(1)) -lemma cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject [simp]: +lemma cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_inject [simp]: "cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r x = cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r y \ x = y" by(simp add: cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) -lemma 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>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_ext_none [simp]: +lemma 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>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_ext_none [simp]: "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>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 (document_ptr.Ext (Inr (Inr document_ext_ptr))) = None" by(simp add: 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>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) -lemma is_shadow_root_ptr_implies_kind [dest]: "is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" +lemma is_shadow_root_ptr_implies_kind [dest]: + "is_shadow_root_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \ is_shadow_root_ptr_kind\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr" by(auto split: option.splits) lemma is_shadow_root_ptr_kind_not_document_ptr [simp]: "\is_shadow_root_ptr_kind (document_ptr.Ref x)"