forked from afp-mirror/Core_DOM
Use symlinks for shared files.
This commit is contained in:
parent
86ea8d4817
commit
c044d5fd86
|
@ -1,39 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>The Core DOM\<close>
|
||||
text\<open>This theory is the main entry point of our formalization of the core DOM.\<close>
|
||||
|
||||
theory Core_DOM
|
||||
imports
|
||||
"Core_DOM_Heap_WF"
|
||||
begin
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../Core_DOM/common/Core_DOM.thy
|
|
@ -1,66 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
*******************************************************************************\***)
|
||||
|
||||
section\<open>Basic Data Types\<close>
|
||||
text\<open>
|
||||
\label{sec:Core_DOM_Basic_Datatypes}
|
||||
This theory formalizes the primitive data types used by the DOM standard~\cite{dom-specification}.
|
||||
\<close>
|
||||
theory Core_DOM_Basic_Datatypes
|
||||
imports
|
||||
Main
|
||||
begin
|
||||
|
||||
type_synonym USVString = string
|
||||
text\<open>
|
||||
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.
|
||||
\<close>
|
||||
|
||||
type_synonym DOMString = string
|
||||
text\<open>
|
||||
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.
|
||||
\<close>
|
||||
|
||||
type_synonym doctype = DOMString
|
||||
|
||||
paragraph\<open>Examples\<close>
|
||||
definition html :: doctype
|
||||
where "html = ''<!DOCTYPE html>''"
|
||||
|
||||
hide_const id
|
||||
|
||||
text \<open>This dummy locale is used to create scoped definitions by using global interpretations
|
||||
and defines.\<close>
|
||||
locale l_dummy
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../Core_DOM/common/Core_DOM_Basic_Datatypes.thy
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1 @@
|
|||
../../Core_DOM/common/Core_DOM_Functions.thy
|
|
@ -1,40 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Core DOM Test Cases\<close>
|
||||
text\<open>This theory aggregates the individual test cases for the core DOM.\<close>
|
||||
|
||||
theory Core_DOM_Tests
|
||||
imports
|
||||
"tests/Document_adoptNode"
|
||||
"tests/Document_getElementById"
|
||||
"tests/Node_insertBefore"
|
||||
"tests/Node_removeChild"
|
||||
begin
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../Core_DOM/common/Core_DOM_Tests.thy
|
|
@ -1,74 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>The Class Infrastructure\<close>
|
||||
text\<open>In this theory, we introduce the basic infrastructure for our encoding
|
||||
of classes.\<close>
|
||||
theory BaseClass
|
||||
imports
|
||||
"HOL-Library.Finite_Map"
|
||||
"../pointers/Ref"
|
||||
"../Core_DOM_Basic_Datatypes"
|
||||
begin
|
||||
|
||||
named_theorems instances
|
||||
|
||||
consts get :: 'a
|
||||
consts put :: 'a
|
||||
consts delete :: 'a
|
||||
|
||||
text \<open>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
|
||||
our types manifest. Second, we get a convenient notation to define classes, in
|
||||
addition to automatically generated getter and setter functions.\<close>
|
||||
|
||||
text \<open>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.\<close>
|
||||
|
||||
text \<open>Throughout the theory files, we will use underscore case to reference pointer
|
||||
types, and camel case for class types.\<close>
|
||||
|
||||
text \<open>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.\<close>
|
||||
|
||||
|
||||
locale l_type_wf = fixes type_wf :: "'heap \<Rightarrow> bool"
|
||||
|
||||
locale l_known_ptr = fixes known_ptr :: "'ptr \<Rightarrow> bool"
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/classes/BaseClass.thy
|
|
@ -1,350 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>CharacterData\<close>
|
||||
text\<open>In this theory, we introduce the types for the CharacterData class.\<close>
|
||||
theory CharacterDataClass
|
||||
imports
|
||||
ElementClass
|
||||
begin
|
||||
|
||||
subsubsection\<open>CharacterData\<close>
|
||||
|
||||
text\<open>The type @{type "DOMString"} is a type synonym for @{type "string"}, defined
|
||||
\autoref{sec:Core_DOM_Basic_Datatypes}.\<close>
|
||||
|
||||
record RCharacterData = RNode +
|
||||
nothing :: unit
|
||||
val :: DOMString
|
||||
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,
|
||||
'Element, 'CharacterData) Node
|
||||
= "('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,
|
||||
'Element, 'CharacterData) 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"
|
||||
|
||||
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, 'CharacterData option RCharacterData_ext + 'Node, 'Element) heap"
|
||||
register_default_tvars "('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr,
|
||||
'shadow_root_ptr, 'Object, 'Node, 'Element, 'CharacterData) heap"
|
||||
type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit, unit, unit, unit, unit, unit, unit) heap"
|
||||
|
||||
|
||||
definition character_data_ptr_kinds :: "(_) heap \<Rightarrow> (_) character_data_ptr fset"
|
||||
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|} |\<union>| character_data_ptr_kinds h"
|
||||
apply(auto simp add: character_data_ptr_kinds_def)[1]
|
||||
by force
|
||||
|
||||
definition character_data_ptrs :: "(_) heap \<Rightarrow> _ character_data_ptr fset"
|
||||
where
|
||||
"character_data_ptrs heap = ffilter is_character_data_ptr (character_data_ptr_kinds heap)"
|
||||
|
||||
abbreviation "character_data_ptr_exts heap \<equiv> character_data_ptr_kinds heap - character_data_ptrs heap"
|
||||
|
||||
definition 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 \<Rightarrow> (_) CharacterData option"
|
||||
where
|
||||
"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 = (case RNode.more node of
|
||||
Inr (Inl character_data) \<Rightarrow> Some (RNode.extend (RNode.truncate node) character_data)
|
||||
| _ \<Rightarrow> None)"
|
||||
adhoc_overloading cast 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
|
||||
|
||||
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 \<Rightarrow> (_) 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 \<equiv> (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 \<Rightarrow> 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 \<Rightarrow> 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
|
||||
|
||||
definition 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 :: "(_) CharacterData \<Rightarrow> (_) Node"
|
||||
where
|
||||
"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 = RNode.extend (RNode.truncate character_data)
|
||||
(Inr (Inl (RNode.more character_data)))"
|
||||
adhoc_overloading cast 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
|
||||
|
||||
abbreviation 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>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "(_) CharacterData \<Rightarrow> (_) Object"
|
||||
where
|
||||
"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>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr \<equiv> cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t (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 ptr)"
|
||||
adhoc_overloading cast 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>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
|
||||
consts is_character_data_kind :: 'a
|
||||
definition is_character_data_kind\<^sub>N\<^sub>o\<^sub>d\<^sub>e :: "(_) Node \<Rightarrow> bool"
|
||||
where
|
||||
"is_character_data_kind\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr \<longleftrightarrow> 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 ptr \<noteq> None"
|
||||
|
||||
adhoc_overloading is_character_data_kind is_character_data_kind\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
lemmas is_character_data_kind_def = is_character_data_kind\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def
|
||||
|
||||
abbreviation is_character_data_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "(_) Object \<Rightarrow> bool"
|
||||
where
|
||||
"is_character_data_kind\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr \<equiv> 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 ptr \<noteq> None"
|
||||
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 |\<in>| node_ptr_kinds h
|
||||
\<longleftrightarrow> character_data_ptr |\<in>| 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
|
||||
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 \<Rightarrow> (_) heap \<Rightarrow> (_) CharacterData option"
|
||||
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
|
||||
|
||||
locale 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
|
||||
begin
|
||||
definition a_type_wf :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_type_wf h = (ElementClass.type_wf h
|
||||
\<and> (\<forall>character_data_ptr \<in> fset (character_data_ptr_kinds h).
|
||||
get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr h \<noteq> None))"
|
||||
end
|
||||
global_interpretation l_type_wf_def\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a defines type_wf = a_type_wf .
|
||||
lemmas type_wf_defs = a_type_wf_def
|
||||
|
||||
locale 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 = l_type_wf type_wf for type_wf :: "((_) heap \<Rightarrow> bool)" +
|
||||
assumes 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: "type_wf h \<Longrightarrow> CharacterDataClass.type_wf h"
|
||||
|
||||
sublocale 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 \<subseteq> l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
apply(unfold_locales)
|
||||
using ElementClass.a_type_wf_def
|
||||
by (meson CharacterDataClass.a_type_wf_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_axioms 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)
|
||||
|
||||
locale 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 = 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
|
||||
begin
|
||||
sublocale l_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas by unfold_locales
|
||||
|
||||
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 |\<in>| character_data_ptr_kinds h
|
||||
\<longleftrightarrow> 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 \<noteq> 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))
|
||||
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
|
||||
by unfold_locales
|
||||
|
||||
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 \<Rightarrow> (_) CharacterData \<Rightarrow> (_) heap \<Rightarrow> (_) 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)
|
||||
(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
|
||||
|
||||
lemma 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:
|
||||
assumes "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 = h'"
|
||||
shows "character_data_ptr |\<in>| character_data_ptr_kinds h'"
|
||||
using assms put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ptr_in_heap
|
||||
unfolding 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 character_data_ptr_kinds_def
|
||||
by (metis character_data_ptr_kinds_commutes character_data_ptr_kinds_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ptr_in_heap)
|
||||
|
||||
lemma 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_put_ptrs:
|
||||
assumes "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 = h'"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast character_data_ptr|}"
|
||||
using assms
|
||||
by (simp add: 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_put_ptrs)
|
||||
|
||||
|
||||
lemma 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_inject [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 x = 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 y \<longleftrightarrow> x = y"
|
||||
apply(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 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>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 \<longleftrightarrow> \<not> (\<exists>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
|
||||
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]:
|
||||
"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 \<longleftrightarrow> 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
|
||||
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]:
|
||||
"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
|
||||
|
||||
lemma cast_element_not_character_data [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 element \<noteq> 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>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 \<noteq> 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)
|
||||
= 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 \<noteq> character_data_ptr' \<Longrightarrow> 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]:
|
||||
"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]:
|
||||
"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)
|
||||
|
||||
lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_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 [simp]:
|
||||
assumes "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_element_ptr, h')"
|
||||
shows "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 ptr 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 ptr h'"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
|
||||
|
||||
abbreviation "create_character_data_obj val_arg
|
||||
\<equiv> \<lparr> RObject.nothing = (), RNode.nothing = (), RCharacterData.nothing = (), val = val_arg, \<dots> = None \<rparr>"
|
||||
|
||||
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 \<Rightarrow> ((_) character_data_ptr \<times> (_) 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
|
||||
|`| (character_data_ptrs h)))) in
|
||||
(new_character_data_ptr, put new_character_data_ptr (create_character_data_obj '''') h))"
|
||||
|
||||
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_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 |\<in>| 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 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))))
|
||||
|\<notin>| character_data_ptrs h"
|
||||
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 |\<notin>| 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)
|
||||
|
||||
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')"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
|
||||
using assms
|
||||
by (metis Pair_inject 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 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_put_ptrs)
|
||||
|
||||
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_is_character_data_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')"
|
||||
shows "is_character_data_ptr new_character_data_ptr"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
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_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t [simp]:
|
||||
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')"
|
||||
assumes "ptr \<noteq> cast new_character_data_ptr"
|
||||
shows "get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
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_get\<^sub>N\<^sub>o\<^sub>d\<^sub>e [simp]:
|
||||
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')"
|
||||
assumes "ptr \<noteq> cast new_character_data_ptr"
|
||||
shows "get\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr h = get\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
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_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t [simp]:
|
||||
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 "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
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_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 [simp]:
|
||||
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')"
|
||||
assumes "ptr \<noteq> new_character_data_ptr"
|
||||
shows "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 ptr 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 ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
|
||||
locale l_known_ptr\<^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
|
||||
begin
|
||||
definition a_known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptr ptr = (known_ptr ptr \<or> is_character_data_ptr ptr)"
|
||||
|
||||
lemma known_ptr_not_character_data_ptr:
|
||||
"\<not>is_character_data_ptr ptr \<Longrightarrow> a_known_ptr ptr \<Longrightarrow> known_ptr ptr"
|
||||
by(simp add: a_known_ptr_def)
|
||||
end
|
||||
global_interpretation l_known_ptr\<^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 known_ptr = a_known_ptr .
|
||||
lemmas known_ptr_defs = a_known_ptr_def
|
||||
|
||||
|
||||
locale 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 = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
begin
|
||||
definition a_known_ptrs :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptrs h = (\<forall>ptr \<in> fset (object_ptr_kinds h). known_ptr ptr)"
|
||||
|
||||
lemma known_ptrs_known_ptr: "a_known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> 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' \<Longrightarrow> a_known_ptrs h = a_known_ptrs h'"
|
||||
by(auto simp add: a_known_ptrs_def)
|
||||
lemma known_ptrs_subset:
|
||||
"object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h \<Longrightarrow> a_known_ptrs h \<Longrightarrow> 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 |\<union>| {|new_ptr|} \<Longrightarrow> known_ptr new_ptr \<Longrightarrow> a_known_ptrs h \<Longrightarrow> a_known_ptrs h'"
|
||||
by(simp add: a_known_ptrs_def)
|
||||
end
|
||||
global_interpretation l_known_ptrs\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a known_ptr defines known_ptrs = a_known_ptrs .
|
||||
lemmas known_ptrs_defs = a_known_ptrs_def
|
||||
|
||||
lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs"
|
||||
using known_ptrs_known_ptr known_ptrs_preserved known_ptrs_subset known_ptrs_new_ptr l_known_ptrs_def
|
||||
by blast
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/classes/CharacterDataClass.thy
|
|
@ -1,340 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Document\<close>
|
||||
text\<open>In this theory, we introduce the types for the Document class.\<close>
|
||||
theory DocumentClass
|
||||
imports
|
||||
CharacterDataClass
|
||||
begin
|
||||
|
||||
text\<open>The type @{type "doctype"} is a type synonym for @{type "string"}, defined
|
||||
in \autoref{sec:Core_DOM_Basic_Datatypes}.\<close>
|
||||
|
||||
record ('node_ptr, 'element_ptr, 'character_data_ptr) RDocument = RObject +
|
||||
nothing :: unit
|
||||
doctype :: doctype
|
||||
document_element :: "(_) element_ptr option"
|
||||
disconnected_nodes :: "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr list"
|
||||
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
|
||||
"('node_ptr, 'element_ptr, 'character_data_ptr, 'Document) Document"
|
||||
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, '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"
|
||||
|
||||
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,
|
||||
'Element, 'CharacterData) heap"
|
||||
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 \<Rightarrow> (_) 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 |`|
|
||||
(ffilter is_document_ptr_kind (object_ptr_kinds heap)))"
|
||||
|
||||
definition document_ptrs :: "(_) heap \<Rightarrow> (_) document_ptr fset"
|
||||
where
|
||||
"document_ptrs heap = ffilter is_document_ptr (document_ptr_kinds heap)"
|
||||
|
||||
definition 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 :: "(_) Object \<Rightarrow> (_) Document option"
|
||||
where
|
||||
"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 = (case RObject.more obj of
|
||||
Inr (Inl document) \<Rightarrow> Some (RObject.extend (RObject.truncate obj) document)
|
||||
| _ \<Rightarrow> None)"
|
||||
adhoc_overloading cast 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
|
||||
|
||||
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 \<Rightarrow> (_) 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)
|
||||
(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
|
||||
|
||||
definition is_document_kind :: "(_) Object \<Rightarrow> bool"
|
||||
where
|
||||
"is_document_kind ptr \<longleftrightarrow> 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 \<noteq> None"
|
||||
|
||||
lemma document_ptr_kinds_simp [simp]:
|
||||
"document_ptr_kinds (Heap (fmupd (cast document_ptr) document (the_heap h)))
|
||||
= {|document_ptr|} |\<union>| document_ptr_kinds h"
|
||||
apply(auto simp add: document_ptr_kinds_def)[1]
|
||||
by force
|
||||
|
||||
lemma document_ptr_kinds_commutes [simp]:
|
||||
"cast document_ptr |\<in>| object_ptr_kinds h \<longleftrightarrow> document_ptr |\<in>| 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
|
||||
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 \<Rightarrow> (_) heap \<Rightarrow> (_) Document option"
|
||||
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
|
||||
|
||||
locale l_type_wf_def\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
definition a_type_wf :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_type_wf h = (CharacterDataClass.type_wf h \<and>
|
||||
(\<forall>document_ptr \<in> 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 \<noteq> None))"
|
||||
end
|
||||
global_interpretation l_type_wf_def\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t defines type_wf = a_type_wf .
|
||||
lemmas type_wf_defs = a_type_wf_def
|
||||
|
||||
locale l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t = l_type_wf type_wf for type_wf :: "((_) heap \<Rightarrow> bool)" +
|
||||
assumes type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t: "type_wf h \<Longrightarrow> DocumentClass.type_wf h"
|
||||
|
||||
sublocale l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t \<subseteq> 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
|
||||
apply(unfold_locales)
|
||||
by (metis (full_types) type_wf_defs l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_axioms l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def)
|
||||
|
||||
locale l_get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas = l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
sublocale 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 by unfold_locales
|
||||
lemma get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf:
|
||||
assumes "type_wf h"
|
||||
shows "document_ptr |\<in>| document_ptr_kinds h \<longleftrightarrow> get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h \<noteq> 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)
|
||||
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
|
||||
|
||||
definition put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) document_ptr \<Rightarrow> (_) Document \<Rightarrow> (_) heap \<Rightarrow> (_) heap"
|
||||
where
|
||||
"put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr document = put (cast document_ptr) (cast document)"
|
||||
adhoc_overloading put put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
|
||||
lemma put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap:
|
||||
assumes "put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr document h = h'"
|
||||
shows "document_ptr |\<in>| document_ptr_kinds h'"
|
||||
using assms
|
||||
unfolding put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def
|
||||
by (metis document_ptr_kinds_commutes put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap)
|
||||
|
||||
lemma put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_put_ptrs:
|
||||
assumes "put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr document h = h'"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast document_ptr|}"
|
||||
using assms
|
||||
by (simp add: put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_put_ptrs)
|
||||
|
||||
|
||||
lemma 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_inject [simp]: "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 x = 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 y \<longleftrightarrow> x = y"
|
||||
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]:
|
||||
"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 \<longleftrightarrow> \<not> (\<exists>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
|
||||
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]:
|
||||
"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 \<longleftrightarrow> 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
|
||||
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"
|
||||
by simp
|
||||
|
||||
lemma cast_document_not_node [simp]:
|
||||
"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 \<noteq> 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>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node \<noteq> 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]:
|
||||
"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 \<noteq> document_ptr'
|
||||
\<Longrightarrow> 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]:
|
||||
"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"
|
||||
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]:
|
||||
"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"
|
||||
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]:
|
||||
assumes "new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_element_ptr, h')"
|
||||
shows "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
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_get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t [simp]:
|
||||
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 "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
|
||||
|
||||
abbreviation
|
||||
create_document_obj :: "char list \<Rightarrow> (_) element_ptr option \<Rightarrow> (_) node_ptr list \<Rightarrow> (_) Document"
|
||||
where
|
||||
"create_document_obj doctype_arg document_element_arg disconnected_nodes_arg
|
||||
\<equiv> \<lparr> RObject.nothing = (), RDocument.nothing = (), doctype = doctype_arg,
|
||||
document_element = document_element_arg,
|
||||
disconnected_nodes = disconnected_nodes_arg, \<dots> = None \<rparr>"
|
||||
|
||||
definition new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_)heap \<Rightarrow> ((_) document_ptr \<times> (_) 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)))))
|
||||
in
|
||||
(new_document_ptr, put new_document_ptr (create_document_obj '''' None []) h))"
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "new_document_ptr |\<in>| 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 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))))
|
||||
|\<notin>| document_ptrs h"
|
||||
by (metis Suc_n_not_le_n document_ptr.sel(1) fMax_ge fimage_finsert finsertI1 finsertI2 set_finsert)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_not_in_heap:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "new_document_ptr |\<notin>| 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
|
||||
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:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_document_ptr|}"
|
||||
using assms
|
||||
by (metis Pair_inject new\<^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_put_ptrs)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_is_document_ptr:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "is_document_ptr new_document_ptr"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t [simp]:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
assumes "ptr \<noteq> cast new_document_ptr"
|
||||
shows "get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: 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)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>N\<^sub>o\<^sub>d\<^sub>e [simp]:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "get\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr h = get\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr h'"
|
||||
using assms
|
||||
apply(simp add: 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)
|
||||
by(auto simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t [simp]:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_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 [simp]:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
shows "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 ptr 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 ptr h'"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
lemma new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^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]:
|
||||
assumes "new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h = (new_document_ptr, h')"
|
||||
assumes "ptr \<noteq> new_document_ptr"
|
||||
shows "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t ptr h'"
|
||||
using assms
|
||||
by(auto simp add: new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def Let_def)
|
||||
|
||||
|
||||
locale l_known_ptr\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
definition a_known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptr ptr = (known_ptr ptr \<or> is_document_ptr ptr)"
|
||||
|
||||
lemma known_ptr_not_document_ptr: "\<not>is_document_ptr ptr \<Longrightarrow> a_known_ptr ptr \<Longrightarrow> known_ptr ptr"
|
||||
by(simp add: a_known_ptr_def)
|
||||
end
|
||||
global_interpretation l_known_ptr\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t defines known_ptr = a_known_ptr .
|
||||
lemmas known_ptr_defs = a_known_ptr_def
|
||||
|
||||
|
||||
locale l_known_ptrs\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
begin
|
||||
definition a_known_ptrs :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptrs h = (\<forall>ptr \<in> fset (object_ptr_kinds h). known_ptr ptr)"
|
||||
|
||||
lemma known_ptrs_known_ptr: "a_known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> 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' \<Longrightarrow> a_known_ptrs h = a_known_ptrs h'"
|
||||
by(auto simp add: a_known_ptrs_def)
|
||||
lemma known_ptrs_subset:
|
||||
"object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h \<Longrightarrow> a_known_ptrs h \<Longrightarrow> 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 |\<union>| {|new_ptr|} \<Longrightarrow> known_ptr new_ptr \<Longrightarrow> a_known_ptrs h \<Longrightarrow> a_known_ptrs h'"
|
||||
by(simp add: a_known_ptrs_def)
|
||||
end
|
||||
global_interpretation l_known_ptrs\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t known_ptr defines known_ptrs = a_known_ptrs .
|
||||
lemmas known_ptrs_defs = a_known_ptrs_def
|
||||
|
||||
lemma known_ptrs_is_l_known_ptrs [instances]: "l_known_ptrs known_ptr known_ptrs"
|
||||
using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset known_ptrs_new_ptr
|
||||
by blast
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/classes/DocumentClass.thy
|
|
@ -1,204 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
|
||||
section\<open>Node\<close>
|
||||
text\<open>In this theory, we introduce the types for the Node class.\<close>
|
||||
|
||||
theory NodeClass
|
||||
imports
|
||||
ObjectClass
|
||||
"../pointers/NodePointer"
|
||||
begin
|
||||
|
||||
subsubsection\<open>Node\<close>
|
||||
|
||||
record RNode = RObject
|
||||
+ nothing :: unit
|
||||
register_default_tvars "'Node RNode_ext"
|
||||
type_synonym 'Node Node = "'Node RNode_scheme"
|
||||
register_default_tvars "'Node Node"
|
||||
type_synonym ('Object, 'Node) Object = "('Node RNode_ext + 'Object) 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"
|
||||
type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit) heap"
|
||||
|
||||
|
||||
definition node_ptr_kinds :: "(_) heap \<Rightarrow> (_) node_ptr fset"
|
||||
where
|
||||
"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)))
|
||||
= {|node_ptr|} |\<union>| 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 \<Rightarrow> (_) 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
|
||||
\<Rightarrow> Some (RObject.extend (RObject.truncate obj) node) | _ \<Rightarrow> 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
|
||||
|
||||
definition cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t:: "(_) Node \<Rightarrow> (_) Object"
|
||||
where
|
||||
"cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node = (RObject.extend (RObject.truncate node) (Inl (RObject.more node)))"
|
||||
adhoc_overloading cast cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
|
||||
definition is_node_kind :: "(_) Object \<Rightarrow> bool"
|
||||
where
|
||||
"is_node_kind ptr \<longleftrightarrow> cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e ptr \<noteq> None"
|
||||
|
||||
definition get\<^sub>N\<^sub>o\<^sub>d\<^sub>e :: "(_) node_ptr \<Rightarrow> (_) heap \<Rightarrow> (_) Node option"
|
||||
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
|
||||
|
||||
locale l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
begin
|
||||
definition a_type_wf :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_type_wf h = (ObjectClass.type_wf h
|
||||
\<and> (\<forall>node_ptr \<in> fset( node_ptr_kinds h). get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h \<noteq> None))"
|
||||
end
|
||||
global_interpretation l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e defines type_wf = a_type_wf .
|
||||
lemmas type_wf_defs = a_type_wf_def
|
||||
|
||||
locale l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e = l_type_wf type_wf for type_wf :: "((_) heap \<Rightarrow> bool)" +
|
||||
assumes type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e: "type_wf h \<Longrightarrow> NodeClass.type_wf h"
|
||||
|
||||
sublocale l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e \<subseteq> l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
apply(unfold_locales)
|
||||
using ObjectClass.a_type_wf_def by auto
|
||||
|
||||
locale l_get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas = l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
begin
|
||||
sublocale l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas by unfold_locales
|
||||
lemma get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf:
|
||||
assumes "type_wf h"
|
||||
shows "node_ptr |\<in>| node_ptr_kinds h \<longleftrightarrow> get\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr h \<noteq> 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))
|
||||
end
|
||||
|
||||
global_interpretation l_get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas type_wf
|
||||
by unfold_locales
|
||||
|
||||
definition put\<^sub>N\<^sub>o\<^sub>d\<^sub>e :: "(_) node_ptr \<Rightarrow> (_) Node \<Rightarrow> (_) heap \<Rightarrow> (_) heap"
|
||||
where
|
||||
"put\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr node = put (cast node_ptr) (cast node)"
|
||||
adhoc_overloading put put\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
|
||||
lemma put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ptr_in_heap:
|
||||
assumes "put\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr node h = h'"
|
||||
shows "node_ptr |\<in>| 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
|
||||
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:
|
||||
assumes "put\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr node h = h'"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast node_ptr|}"
|
||||
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]:
|
||||
"cast node_ptr |\<in>| object_ptr_kinds h \<longleftrightarrow> node_ptr |\<in>| 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
|
||||
is_node_ptr_kind_none node_ptr_casts_commute2
|
||||
option.distinct(1) option.sel)
|
||||
|
||||
lemma node_empty [simp]:
|
||||
"\<lparr>RObject.nothing = (), RNode.nothing = (), \<dots> = RNode.more node\<rparr> = node"
|
||||
by simp
|
||||
|
||||
lemma cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_inject [simp]: "cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x = cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t y \<longleftrightarrow> x = y"
|
||||
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]:
|
||||
"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 \<longleftrightarrow> \<not> (\<exists>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)
|
||||
|
||||
lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_some [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 = Some node \<longleftrightarrow> cast node = obj"
|
||||
by(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)
|
||||
|
||||
lemma cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv [simp]: "cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e (cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node) = Some node"
|
||||
by simp
|
||||
|
||||
locale l_known_ptr\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
begin
|
||||
definition a_known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptr ptr = False"
|
||||
end
|
||||
global_interpretation l_known_ptr\<^sub>N\<^sub>o\<^sub>d\<^sub>e defines known_ptr = a_known_ptr .
|
||||
lemmas known_ptr_defs = a_known_ptr_def
|
||||
|
||||
|
||||
locale l_known_ptrs\<^sub>N\<^sub>o\<^sub>d\<^sub>e = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
begin
|
||||
definition a_known_ptrs :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptrs h = (\<forall>ptr \<in> fset (object_ptr_kinds h). known_ptr ptr)"
|
||||
|
||||
lemma known_ptrs_known_ptr: "a_known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> 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' \<Longrightarrow> a_known_ptrs h = a_known_ptrs h'"
|
||||
by(auto simp add: a_known_ptrs_def)
|
||||
lemma known_ptrs_subset: "object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h \<Longrightarrow> a_known_ptrs h \<Longrightarrow> 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 |\<union>| {|new_ptr|} \<Longrightarrow> known_ptr new_ptr \<Longrightarrow> a_known_ptrs h \<Longrightarrow> 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
|
||||
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]:
|
||||
"node_ptr \<noteq> node_ptr' \<Longrightarrow> 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)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/classes/NodeClass.thy
|
|
@ -1,217 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Object\<close>
|
||||
text\<open>In this theory, we introduce the definition of the class Object. This class is the
|
||||
common superclass of our class model.\<close>
|
||||
|
||||
theory ObjectClass
|
||||
imports
|
||||
BaseClass
|
||||
"../pointers/ObjectPointer"
|
||||
begin
|
||||
|
||||
record RObject =
|
||||
nothing :: unit
|
||||
register_default_tvars "'Object RObject_ext"
|
||||
type_synonym 'Object Object = "'Object RObject_scheme"
|
||||
register_default_tvars "'Object Object"
|
||||
|
||||
datatype ('object_ptr, 'Object) heap = Heap (the_heap: "((_) object_ptr, (_) Object) fmap")
|
||||
register_default_tvars "('object_ptr, 'Object) heap"
|
||||
type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit) heap"
|
||||
|
||||
definition object_ptr_kinds :: "(_) heap \<Rightarrow> (_) object_ptr fset"
|
||||
where
|
||||
"object_ptr_kinds = fmdom \<circ> the_heap"
|
||||
|
||||
lemma object_ptr_kinds_simp [simp]:
|
||||
"object_ptr_kinds (Heap (fmupd object_ptr object (the_heap h)))
|
||||
= {|object_ptr|} |\<union>| 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 \<Rightarrow> (_) heap \<Rightarrow> (_) 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
|
||||
|
||||
locale l_type_wf_def\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
begin
|
||||
definition a_type_wf :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_type_wf h = True"
|
||||
end
|
||||
global_interpretation l_type_wf_def\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t defines type_wf = a_type_wf .
|
||||
lemmas type_wf_defs = a_type_wf_def
|
||||
|
||||
locale l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t = l_type_wf type_wf for type_wf :: "((_) heap \<Rightarrow> bool)" +
|
||||
assumes type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: "type_wf h \<Longrightarrow> ObjectClass.type_wf h"
|
||||
|
||||
locale l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas = l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
begin
|
||||
lemma get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf:
|
||||
assumes "type_wf h"
|
||||
shows "object_ptr |\<in>| object_ptr_kinds h \<longleftrightarrow> get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr h \<noteq> None"
|
||||
using l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_axioms assms
|
||||
apply(simp add: type_wf_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def)
|
||||
by (simp add: fmlookup_dom_iff object_ptr_kinds_def)
|
||||
end
|
||||
|
||||
global_interpretation l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas type_wf
|
||||
by (simp add: l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas.intro l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t.intro)
|
||||
|
||||
definition put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "(_) object_ptr \<Rightarrow> (_) Object \<Rightarrow> (_) heap \<Rightarrow> (_) heap"
|
||||
where
|
||||
"put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h = Heap (fmupd ptr obj (the_heap h))"
|
||||
adhoc_overloading put put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
|
||||
lemma put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap:
|
||||
assumes "put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr object h = h'"
|
||||
shows "object_ptr |\<in>| object_ptr_kinds h'"
|
||||
using assms
|
||||
unfolding put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def
|
||||
by auto
|
||||
|
||||
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 |\<union>| {|object_ptr|}"
|
||||
using assms
|
||||
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"
|
||||
by(simp add: extend_def)
|
||||
|
||||
lemma object_empty [simp]: "\<lparr>nothing = (), \<dots> = more x\<rparr> = x"
|
||||
by simp
|
||||
|
||||
locale l_known_ptr\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
begin
|
||||
definition a_known_ptr :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptr ptr = False"
|
||||
|
||||
lemma known_ptr_not_object_ptr:
|
||||
"a_known_ptr ptr \<Longrightarrow> \<not>is_object_ptr ptr \<Longrightarrow> known_ptr ptr"
|
||||
by(simp add: a_known_ptr_def)
|
||||
end
|
||||
global_interpretation l_known_ptr\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t defines known_ptr = a_known_ptr .
|
||||
lemmas known_ptr_defs = a_known_ptr_def
|
||||
|
||||
locale l_known_ptrs = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \<Rightarrow> bool" +
|
||||
fixes known_ptrs :: "(_) heap \<Rightarrow> bool"
|
||||
assumes known_ptrs_known_ptr: "known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> known_ptr ptr"
|
||||
assumes known_ptrs_preserved: "object_ptr_kinds h = object_ptr_kinds h' \<Longrightarrow> known_ptrs h = known_ptrs h'"
|
||||
assumes known_ptrs_subset: "object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h \<Longrightarrow> known_ptrs h \<Longrightarrow> known_ptrs h'"
|
||||
assumes known_ptrs_new_ptr: "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|new_ptr|} \<Longrightarrow> known_ptr new_ptr \<Longrightarrow> known_ptrs h \<Longrightarrow> 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 \<Rightarrow> bool"
|
||||
begin
|
||||
definition a_known_ptrs :: "(_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"a_known_ptrs h = (\<forall>ptr \<in> fset (object_ptr_kinds h). known_ptr ptr)"
|
||||
|
||||
lemma known_ptrs_known_ptr:
|
||||
"a_known_ptrs h \<Longrightarrow> ptr |\<in>| object_ptr_kinds h \<Longrightarrow> 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' \<Longrightarrow> a_known_ptrs h = a_known_ptrs h'"
|
||||
by(auto simp add: a_known_ptrs_def)
|
||||
lemma known_ptrs_subset: "object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h \<Longrightarrow> a_known_ptrs h \<Longrightarrow> 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 |\<union>| {|new_ptr|} \<Longrightarrow> known_ptr new_ptr \<Longrightarrow> a_known_ptrs h \<Longrightarrow> a_known_ptrs h'"
|
||||
by(simp add: a_known_ptrs_def)
|
||||
end
|
||||
global_interpretation l_known_ptrs\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t known_ptr defines known_ptrs = a_known_ptrs .
|
||||
lemmas known_ptrs_defs = a_known_ptrs_def
|
||||
|
||||
lemma known_ptrs_is_l_known_ptrs: "l_known_ptrs known_ptr known_ptrs"
|
||||
using known_ptrs_known_ptr known_ptrs_preserved l_known_ptrs_def known_ptrs_subset known_ptrs_new_ptr
|
||||
by blast
|
||||
|
||||
|
||||
lemma get_object_ptr_simp1 [simp]: "get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr object h) = Some object"
|
||||
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 \<noteq> object_ptr'
|
||||
\<Longrightarrow> 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)
|
||||
|
||||
|
||||
subsection\<open>Limited Heap Modifications\<close>
|
||||
|
||||
definition heap_unchanged_except :: "(_) object_ptr set \<Rightarrow> (_) heap \<Rightarrow> (_) heap \<Rightarrow> bool"
|
||||
where
|
||||
"heap_unchanged_except S h h' = (\<forall>ptr \<in> (fset (object_ptr_kinds h)
|
||||
\<union> (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 \<Rightarrow> (_) heap \<Rightarrow> (_) heap option" where
|
||||
"delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = (if ptr |\<in>| 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:
|
||||
assumes "delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = Some h'"
|
||||
shows "ptr |\<notin>| object_ptr_kinds h'"
|
||||
using assms
|
||||
by(auto simp add: delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def object_ptr_kinds_def split: if_splits)
|
||||
|
||||
lemma delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_pointer_ptr_in_heap:
|
||||
assumes "delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h = Some h'"
|
||||
shows "ptr |\<in>| object_ptr_kinds h"
|
||||
using assms
|
||||
by(auto simp add: delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def object_ptr_kinds_def split: if_splits)
|
||||
|
||||
lemma delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok:
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
shows "delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr h \<noteq> None"
|
||||
using assms
|
||||
by(auto simp add: delete\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def object_ptr_kinds_def split: if_splits)
|
||||
|
||||
|
||||
subsection \<open>Code Generator Setup\<close>
|
||||
|
||||
definition "create_heap xs = Heap (fmap_of_list xs)"
|
||||
|
||||
code_datatype ObjectClass.heap.Heap create_heap
|
||||
|
||||
lemma object_ptr_kinds_code3 [code]:
|
||||
"fmlookup (the_heap (create_heap xs)) x = map_of xs x"
|
||||
by(auto simp add: create_heap_def fmlookup_of_list)
|
||||
|
||||
lemma object_ptr_kinds_code4 [code]:
|
||||
"the_heap (create_heap xs) = fmap_of_list xs"
|
||||
by(simp add: create_heap_def)
|
||||
|
||||
lemma object_ptr_kinds_code5 [code]:
|
||||
"the_heap (Heap x) = x"
|
||||
by simp
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/classes/ObjectClass.thy
|
|
@ -1,376 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>The Monad Infrastructure\<close>
|
||||
text\<open>In this theory, we introduce the basic infrastructure for our monadic class encoding.\<close>
|
||||
theory BaseMonad
|
||||
imports
|
||||
"../classes/BaseClass"
|
||||
"../preliminaries/Heap_Error_Monad"
|
||||
begin
|
||||
subsection\<open>Datatypes\<close>
|
||||
|
||||
datatype exception = NotFoundError | SegmentationFault | HierarchyRequestError | AssertException
|
||||
| NonTerminationException | InvokeError | TypeError | DebugException nat
|
||||
|
||||
lemma finite_set_in [simp]: "x \<in> fset FS \<longleftrightarrow> x |\<in>| FS"
|
||||
by (meson notin_fset)
|
||||
|
||||
consts put_M :: 'a
|
||||
consts get_M :: 'a
|
||||
consts delete_M :: 'a
|
||||
|
||||
lemma sorted_list_of_set_eq [dest]:
|
||||
"sorted_list_of_set (fset x) = sorted_list_of_set (fset y) \<Longrightarrow> x = y"
|
||||
by (metis finite_fset fset_inject sorted_list_of_set(1))
|
||||
|
||||
|
||||
locale l_ptr_kinds_M =
|
||||
fixes ptr_kinds :: "'heap \<Rightarrow> 'ptr::linorder fset"
|
||||
begin
|
||||
definition a_ptr_kinds_M :: "('heap, exception, 'ptr list) prog"
|
||||
where
|
||||
"a_ptr_kinds_M = do {
|
||||
h \<leftarrow> get_heap;
|
||||
return (sorted_list_of_set (fset (ptr_kinds h)))
|
||||
}"
|
||||
|
||||
lemma ptr_kinds_M_ok [simp]: "h \<turnstile> ok a_ptr_kinds_M"
|
||||
by(simp add: a_ptr_kinds_M_def)
|
||||
|
||||
lemma ptr_kinds_M_pure [simp]: "pure a_ptr_kinds_M h"
|
||||
by (auto simp add: a_ptr_kinds_M_def intro: bind_pure_I)
|
||||
|
||||
lemma ptr_kinds_ptr_kinds_M [simp]: "ptr \<in> set |h \<turnstile> a_ptr_kinds_M|\<^sub>r \<longleftrightarrow> ptr |\<in>| ptr_kinds h"
|
||||
by(simp add: a_ptr_kinds_M_def)
|
||||
|
||||
lemma ptr_kinds_M_ptr_kinds [simp]:
|
||||
"h \<turnstile> a_ptr_kinds_M \<rightarrow>\<^sub>r xa \<longleftrightarrow> 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]:
|
||||
"h \<turnstile> a_ptr_kinds_M \<bind> f \<rightarrow>\<^sub>r x \<longleftrightarrow> h \<turnstile> f (sorted_list_of_set (fset (ptr_kinds h))) \<rightarrow>\<^sub>r x"
|
||||
by(auto simp add: a_ptr_kinds_M_def)
|
||||
lemma ptr_kinds_M_ptr_kinds_returns_heap [simp]:
|
||||
"h \<turnstile> a_ptr_kinds_M \<bind> f \<rightarrow>\<^sub>h h' \<longleftrightarrow> h \<turnstile> f (sorted_list_of_set (fset (ptr_kinds h))) \<rightarrow>\<^sub>h h'"
|
||||
by(auto simp add: a_ptr_kinds_M_def)
|
||||
end
|
||||
|
||||
locale l_get_M =
|
||||
fixes get :: "'ptr \<Rightarrow> 'heap \<Rightarrow> 'obj option"
|
||||
fixes type_wf :: "'heap \<Rightarrow> bool"
|
||||
fixes ptr_kinds :: "'heap \<Rightarrow> 'ptr fset"
|
||||
assumes "type_wf h \<Longrightarrow> ptr |\<in>| ptr_kinds h \<Longrightarrow> get ptr h \<noteq> None"
|
||||
assumes "get ptr h \<noteq> None \<Longrightarrow> ptr |\<in>| ptr_kinds h"
|
||||
begin
|
||||
|
||||
definition a_get_M :: "'ptr \<Rightarrow> ('obj \<Rightarrow> 'result) \<Rightarrow> ('heap, exception, 'result) prog"
|
||||
where
|
||||
"a_get_M ptr getter = (do {
|
||||
h \<leftarrow> get_heap;
|
||||
(case get ptr h of
|
||||
Some res \<Rightarrow> return (getter res)
|
||||
| None \<Rightarrow> error SegmentationFault)
|
||||
})"
|
||||
|
||||
lemma get_M_pure [simp]: "pure (a_get_M ptr getter) h"
|
||||
by(auto simp add: a_get_M_def bind_pure_I split: option.splits)
|
||||
|
||||
lemma get_M_ok:
|
||||
"type_wf h \<Longrightarrow> ptr |\<in>| ptr_kinds h \<Longrightarrow> h \<turnstile> ok (a_get_M ptr getter)"
|
||||
apply(simp add: a_get_M_def)
|
||||
by (metis l_get_M_axioms l_get_M_def option.case_eq_if return_ok)
|
||||
lemma get_M_ptr_in_heap:
|
||||
"h \<turnstile> ok (a_get_M ptr getter) \<Longrightarrow> ptr |\<in>| ptr_kinds h"
|
||||
apply(simp add: a_get_M_def)
|
||||
by (metis error_returns_result is_OK_returns_result_E l_get_M_axioms l_get_M_def option.simps(4))
|
||||
|
||||
end
|
||||
|
||||
locale l_put_M = l_get_M get for get :: "'ptr \<Rightarrow> 'heap \<Rightarrow> 'obj option" +
|
||||
fixes put :: "'ptr \<Rightarrow> 'obj \<Rightarrow> 'heap \<Rightarrow> 'heap"
|
||||
begin
|
||||
definition a_put_M :: "'ptr \<Rightarrow> (('v \<Rightarrow> 'v) \<Rightarrow> 'obj \<Rightarrow> 'obj) \<Rightarrow> 'v \<Rightarrow> ('heap, exception, unit) prog"
|
||||
where
|
||||
"a_put_M ptr setter v = (do {
|
||||
obj \<leftarrow> a_get_M ptr id;
|
||||
h \<leftarrow> get_heap;
|
||||
return_heap (put ptr (setter (\<lambda>_. v) obj) h)
|
||||
})"
|
||||
|
||||
lemma put_M_ok:
|
||||
"type_wf h \<Longrightarrow> ptr |\<in>| ptr_kinds h \<Longrightarrow> h \<turnstile> ok (a_put_M ptr setter v)"
|
||||
by(auto simp add: a_put_M_def intro!: bind_is_OK_I2 dest: get_M_ok elim!: bind_is_OK_E)
|
||||
|
||||
lemma put_M_ptr_in_heap:
|
||||
"h \<turnstile> ok (a_put_M ptr setter v) \<Longrightarrow> ptr |\<in>| ptr_kinds h"
|
||||
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 \<open>Setup for Defining Partial Functions\<close>
|
||||
|
||||
lemma execute_admissible:
|
||||
"ccpo.admissible (fun_lub (flat_lub (Inl (e::'e)))) (fun_ord (flat_ord (Inl e)))
|
||||
((\<lambda>a. \<forall>(h::'heap) h2 (r::'result). h \<turnstile> a = Inr (r, h2) \<longrightarrow> P h h2 r) \<circ> Prog)"
|
||||
proof (unfold comp_def, rule ccpo.admissibleI, clarify)
|
||||
fix A :: "('heap \<Rightarrow> 'e + 'result \<times> 'heap) set"
|
||||
let ?lub = "Prog (fun_lub (flat_lub (Inl e)) A)"
|
||||
fix h h2 r
|
||||
assume 1: "Complete_Partial_Order.chain (fun_ord (flat_ord (Inl e))) A"
|
||||
and 2: "\<forall>xa\<in>A. \<forall>h h2 r. h \<turnstile> Prog xa = Inr (r, h2) \<longrightarrow> P h h2 r"
|
||||
and 4: "h \<turnstile> Prog (fun_lub (flat_lub (Inl e)) A) = Inr (r, h2)"
|
||||
have h1:"\<And>a. Complete_Partial_Order.chain (flat_ord (Inl e)) {y. \<exists>f\<in>A. y = f a}"
|
||||
by (rule chain_fun[OF 1])
|
||||
show "P h h2 r"
|
||||
using chain_fun[OF 1] flat_lub_in_chain[OF chain_fun[OF 1]] 2 4 unfolding execute_def fun_lub_def
|
||||
by force
|
||||
qed
|
||||
|
||||
lemma execute_admissible2:
|
||||
"ccpo.admissible (fun_lub (flat_lub (Inl (e::'e)))) (fun_ord (flat_ord (Inl e)))
|
||||
((\<lambda>a. \<forall>(h::'heap) h' h2 h2' (r::'result) r'.
|
||||
h \<turnstile> a = Inr (r, h2) \<longrightarrow> h' \<turnstile> a = Inr (r', h2') \<longrightarrow> P h h' h2 h2' r r') \<circ> Prog)"
|
||||
proof (unfold comp_def, rule ccpo.admissibleI, clarify)
|
||||
fix A :: "('heap \<Rightarrow> 'e + 'result \<times> '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]: "\<forall>xa\<in>A. \<forall>h h' h2 h2' r r'. h \<turnstile> Prog xa = Inr (r, h2)
|
||||
\<longrightarrow> h' \<turnstile> Prog xa = Inr (r', h2') \<longrightarrow> P h h' h2 h2' r r'"
|
||||
and 4: "h \<turnstile> Prog (fun_lub (flat_lub (Inl e)) A) = Inr (r, h2)"
|
||||
and 5: "h' \<turnstile> Prog (fun_lub (flat_lub (Inl e)) A) = Inr (r', h2')"
|
||||
have h1:"\<And>a. Complete_Partial_Order.chain (flat_ord (Inl e)) {y. \<exists>f\<in>A. y = f a}"
|
||||
by (rule chain_fun[OF 1])
|
||||
have "h \<turnstile> ?lub \<in> {y. \<exists>f\<in>A. y = f h}"
|
||||
using flat_lub_in_chain[OF h1] 4
|
||||
unfolding execute_def fun_lub_def
|
||||
by auto
|
||||
moreover have "h' \<turnstile> ?lub \<in> {y. \<exists>f\<in>A. y = f h'}"
|
||||
using flat_lub_in_chain[OF h1] 5
|
||||
unfolding execute_def fun_lub_def
|
||||
by auto
|
||||
ultimately obtain f where
|
||||
"f \<in> A" and
|
||||
"h \<turnstile> Prog f = Inr (r, h2)" and
|
||||
"h' \<turnstile> Prog f = Inr (r', h2')"
|
||||
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 ::
|
||||
"('heap, exception, 'result) prog \<Rightarrow> ('heap, exception, 'result) prog \<Rightarrow> bool" where
|
||||
"dom_prog_ord = img_ord (\<lambda>a b. execute b a) (fun_ord (flat_ord (Inl NonTerminationException)))"
|
||||
|
||||
definition dom_prog_lub ::
|
||||
"('heap, exception, 'result) prog set \<Rightarrow> ('heap, exception, 'result) prog" where
|
||||
"dom_prog_lub = img_lub (\<lambda>a b. execute b a) Prog (fun_lub (flat_lub (Inl NonTerminationException)))"
|
||||
|
||||
lemma dom_prog_lub_empty: "dom_prog_lub {} = error NonTerminationException"
|
||||
by(simp add: dom_prog_lub_def img_lub_def fun_lub_def flat_lub_def error_def)
|
||||
|
||||
lemma dom_prog_interpretation: "partial_function_definitions dom_prog_ord dom_prog_lub"
|
||||
proof -
|
||||
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
|
||||
apply (simp add: dom_prog_lub_def dom_prog_ord_def flat_interpretation execute_def)
|
||||
using partial_function_image prog.expand prog.sel by blast
|
||||
qed
|
||||
|
||||
interpretation dom_prog: partial_function_definitions dom_prog_ord dom_prog_lub
|
||||
rewrites "dom_prog_lub {} \<equiv> error NonTerminationException"
|
||||
by (fact dom_prog_interpretation)(simp add: dom_prog_lub_empty)
|
||||
|
||||
lemma admissible_dom_prog:
|
||||
"dom_prog.admissible (\<lambda>f. \<forall>x h h' r. h \<turnstile> f x \<rightarrow>\<^sub>r r \<longrightarrow> h \<turnstile> f x \<rightarrow>\<^sub>h h' \<longrightarrow> P x h h' r)"
|
||||
proof (rule admissible_fun[OF dom_prog_interpretation])
|
||||
fix x
|
||||
show "ccpo.admissible dom_prog_lub dom_prog_ord (\<lambda>a. \<forall>h h' r. h \<turnstile> a \<rightarrow>\<^sub>r r \<longrightarrow> h \<turnstile> a \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> 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)))
|
||||
(fun_ord (flat_ord (Inl NonTerminationException)))
|
||||
((\<lambda>a. \<forall>h h' r. h \<turnstile> a \<rightarrow>\<^sub>r r \<longrightarrow> h \<turnstile> a \<rightarrow>\<^sub>h h' \<longrightarrow> P x h h' r) \<circ> Prog)"
|
||||
by(auto simp add: execute_admissible returns_result_def returns_heap_def split: sum.splits)
|
||||
next
|
||||
show "\<And>x y. (\<lambda>b. b \<turnstile> x) = (\<lambda>b. b \<turnstile> y) \<Longrightarrow> x = y"
|
||||
by(simp add: execute_def prog.expand)
|
||||
next
|
||||
show "\<And>x. (\<lambda>b. b \<turnstile> Prog x) = x"
|
||||
by(simp add: execute_def)
|
||||
qed
|
||||
qed
|
||||
|
||||
lemma admissible_dom_prog2:
|
||||
"dom_prog.admissible (\<lambda>f. \<forall>x h h2 h' h2' r r2. h \<turnstile> f x \<rightarrow>\<^sub>r r \<longrightarrow> h \<turnstile> f x \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> h2 \<turnstile> f x \<rightarrow>\<^sub>r r2 \<longrightarrow> h2 \<turnstile> f x \<rightarrow>\<^sub>h h2' \<longrightarrow> 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 (\<lambda>a. \<forall>h h2 h' h2' r r2. h \<turnstile> a \<rightarrow>\<^sub>r r
|
||||
\<longrightarrow> h \<turnstile> a \<rightarrow>\<^sub>h h' \<longrightarrow> h2 \<turnstile> a \<rightarrow>\<^sub>r r2 \<longrightarrow> h2 \<turnstile> a \<rightarrow>\<^sub>h h2' \<longrightarrow> 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)))
|
||||
(fun_ord (flat_ord (Inl NonTerminationException)))
|
||||
((\<lambda>a. \<forall>h h2 h' h2' r r2. h \<turnstile> a \<rightarrow>\<^sub>r r \<longrightarrow> h \<turnstile> a \<rightarrow>\<^sub>h h' \<longrightarrow> h2 \<turnstile> a \<rightarrow>\<^sub>r r2 \<longrightarrow> h2 \<turnstile> a \<rightarrow>\<^sub>h h2'
|
||||
\<longrightarrow> P x h h2 h' h2' r r2) \<circ> Prog)"
|
||||
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 "\<And>x y. (\<lambda>b. b \<turnstile> x) = (\<lambda>b. b \<turnstile> y) \<Longrightarrow> x = y"
|
||||
by(simp add: execute_def prog.expand)
|
||||
next
|
||||
show "\<And>x. (\<lambda>b. b \<turnstile> Prog x) = x"
|
||||
by(simp add: execute_def)
|
||||
qed
|
||||
qed
|
||||
|
||||
lemma fixp_induct_dom_prog:
|
||||
fixes F :: "'c \<Rightarrow> 'c" and
|
||||
U :: "'c \<Rightarrow> 'b \<Rightarrow> ('heap, exception, 'result) prog" and
|
||||
C :: "('b \<Rightarrow> ('heap, exception, 'result) prog) \<Rightarrow> 'c" and
|
||||
P :: "'b \<Rightarrow> 'heap \<Rightarrow> 'heap \<Rightarrow> 'result \<Rightarrow> bool"
|
||||
assumes mono: "\<And>x. monotone (fun_ord dom_prog_ord) dom_prog_ord (\<lambda>f. U (F (C f)) x)"
|
||||
assumes eq: "f \<equiv> C (ccpo.fixp (fun_lub dom_prog_lub) (fun_ord dom_prog_ord) (\<lambda>f. U (F (C f))))"
|
||||
assumes inverse2: "\<And>f. U (C f) = f"
|
||||
assumes step: "\<And>f x h h' r. (\<And>x h h' r. h \<turnstile> (U f x) \<rightarrow>\<^sub>r r \<Longrightarrow> h \<turnstile> (U f x) \<rightarrow>\<^sub>h h' \<Longrightarrow> P x h h' r)
|
||||
\<Longrightarrow> h \<turnstile> (U (F f) x) \<rightarrow>\<^sub>r r \<Longrightarrow> h \<turnstile> (U (F f) x) \<rightarrow>\<^sub>h h' \<Longrightarrow> P x h h' r"
|
||||
assumes defined: "h \<turnstile> (U f x) \<rightarrow>\<^sub>r r" and "h \<turnstile> (U f x) \<rightarrow>\<^sub>h h'"
|
||||
shows "P x h h' r"
|
||||
using step defined dom_prog.fixp_induct_uc[of U F C, OF mono eq inverse2 admissible_dom_prog, of P]
|
||||
by (metis assms(6) error_returns_heap)
|
||||
|
||||
declaration \<open>Partial_Function.init "dom_prog" @{term dom_prog.fixp_fun}
|
||||
@{term dom_prog.mono_body} @{thm dom_prog.fixp_rule_uc} @{thm dom_prog.fixp_induct_uc}
|
||||
(SOME @{thm fixp_induct_dom_prog})\<close>
|
||||
|
||||
|
||||
abbreviation "mono_dom_prog \<equiv> monotone (fun_ord dom_prog_ord) dom_prog_ord"
|
||||
|
||||
lemma dom_prog_ordI:
|
||||
assumes "\<And>h. h \<turnstile> f \<rightarrow>\<^sub>e NonTerminationException \<or> h \<turnstile> f = h \<turnstile> g"
|
||||
shows "dom_prog_ord f g"
|
||||
proof(auto simp add: dom_prog_ord_def img_ord_def fun_ord_def flat_ord_def)[1]
|
||||
fix x
|
||||
assume "x \<turnstile> f \<noteq> x \<turnstile> g"
|
||||
then show "x \<turnstile> f = Inl NonTerminationException"
|
||||
using assms[where h=x]
|
||||
by(auto simp add: returns_error_def split: sum.splits)
|
||||
qed
|
||||
|
||||
lemma dom_prog_ordE:
|
||||
assumes "dom_prog_ord x y"
|
||||
obtains "h \<turnstile> x \<rightarrow>\<^sub>e NonTerminationException" | " h \<turnstile> x = h \<turnstile> y"
|
||||
using assms unfolding dom_prog_ord_def img_ord_def fun_ord_def flat_ord_def
|
||||
using returns_error_def by force
|
||||
|
||||
|
||||
lemma bind_mono [partial_function_mono]:
|
||||
fixes B :: "('a \<Rightarrow> ('heap, exception, 'result) prog) \<Rightarrow> ('heap, exception, 'result2) prog"
|
||||
assumes mf: "mono_dom_prog B" and mg: "\<And>y. mono_dom_prog (\<lambda>f. C y f)"
|
||||
shows "mono_dom_prog (\<lambda>f. B f \<bind> (\<lambda>y. C y f))"
|
||||
proof (rule monotoneI)
|
||||
fix f g :: "'a \<Rightarrow> ('heap, exception, 'result) prog"
|
||||
assume fg: "dom_prog.le_fun f g"
|
||||
from mf
|
||||
have 1: "dom_prog_ord (B f) (B g)" by (rule monotoneD) (rule fg)
|
||||
from mg
|
||||
have 2: "\<And>y'. dom_prog_ord (C y' f) (C y' g)" by (rule monotoneD) (rule fg)
|
||||
|
||||
have "dom_prog_ord (B f \<bind> (\<lambda>y. C y f)) (B g \<bind> (\<lambda>y. C y f))"
|
||||
(is "dom_prog_ord ?L ?R")
|
||||
proof (rule dom_prog_ordI)
|
||||
fix h
|
||||
from 1 show "h \<turnstile> ?L \<rightarrow>\<^sub>e NonTerminationException \<or> h \<turnstile> ?L = h \<turnstile> ?R"
|
||||
apply(rule dom_prog_ordE)
|
||||
apply(auto)[1]
|
||||
using bind_cong by fastforce
|
||||
qed
|
||||
also
|
||||
have h1: "dom_prog_ord (B g \<bind> (\<lambda>y'. C y' f)) (B g \<bind> (\<lambda>y'. C y' g))"
|
||||
(is "dom_prog_ord ?L ?R")
|
||||
proof (rule dom_prog_ordI)
|
||||
(* { *)
|
||||
fix h
|
||||
show "h \<turnstile> ?L \<rightarrow>\<^sub>e NonTerminationException \<or> h \<turnstile> ?L = h \<turnstile> ?R"
|
||||
proof (cases "h \<turnstile> ok (B g)")
|
||||
case True
|
||||
then obtain x h' where x: "h \<turnstile> B g \<rightarrow>\<^sub>r x" and h': "h \<turnstile> B g \<rightarrow>\<^sub>h h'"
|
||||
by blast
|
||||
then have "dom_prog_ord (C x f) (C x g)"
|
||||
using 2 by simp
|
||||
then show ?thesis
|
||||
using x h'
|
||||
apply(auto intro!: bind_returns_error_I3 dest: returns_result_eq dest!: dom_prog_ordE)[1]
|
||||
apply(auto simp add: execute_bind_simp)[1]
|
||||
using "2" dom_prog_ordE by metis
|
||||
next
|
||||
case False
|
||||
then obtain e where e: "h \<turnstile> B g \<rightarrow>\<^sub>e e"
|
||||
by(simp add: is_OK_def returns_error_def split: sum.splits)
|
||||
have "h \<turnstile> B g \<bind> (\<lambda>y'. C y' f) \<rightarrow>\<^sub>e e"
|
||||
using e by(auto)
|
||||
moreover have "h \<turnstile> B g \<bind> (\<lambda>y'. C y' g) \<rightarrow>\<^sub>e e"
|
||||
using e by auto
|
||||
ultimately show ?thesis
|
||||
using bind_returns_error_eq by metis
|
||||
qed
|
||||
qed
|
||||
finally (dom_prog.leq_trans)
|
||||
show "dom_prog_ord (B f \<bind> (\<lambda>y. C y f)) (B g \<bind> (\<lambda>y'. C y' g))" .
|
||||
qed
|
||||
|
||||
lemma mono_dom_prog1 [partial_function_mono]:
|
||||
fixes g :: "('a \<Rightarrow> ('heap, exception, 'result) prog) \<Rightarrow> 'b \<Rightarrow> ('heap, exception, 'result) prog"
|
||||
assumes "\<And>x. (mono_dom_prog (\<lambda>f. g f x))"
|
||||
shows "mono_dom_prog (\<lambda>f. map_M (g f) xs)"
|
||||
using assms
|
||||
apply (induct xs)
|
||||
by(auto simp add: call_mono dom_prog.const_mono intro!: bind_mono)
|
||||
|
||||
lemma mono_dom_prog2 [partial_function_mono]:
|
||||
fixes g :: "('a \<Rightarrow> ('heap, exception, 'result) prog) \<Rightarrow> 'b \<Rightarrow> ('heap, exception, 'result) prog"
|
||||
assumes "\<And>x. (mono_dom_prog (\<lambda>f. g f x))"
|
||||
shows "mono_dom_prog (\<lambda>f. forall_M (g f) xs)"
|
||||
using assms
|
||||
apply (induct xs)
|
||||
by(auto simp add: call_mono dom_prog.const_mono intro!: bind_mono)
|
||||
|
||||
lemma sorted_list_set_cong [simp]:
|
||||
"sorted_list_of_set (fset FS) = sorted_list_of_set (fset FS') \<longleftrightarrow> FS = FS'"
|
||||
by auto
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/BaseMonad.thy
|
|
@ -1,531 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>CharacterData\<close>
|
||||
text\<open>In this theory, we introduce the monadic method setup for the CharacterData class.\<close>
|
||||
theory CharacterDataMonad
|
||||
imports
|
||||
ElementMonad
|
||||
"../classes/CharacterDataClass"
|
||||
begin
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
|
||||
shows "|h \<turnstile> character_data_ptr_kinds_M|\<^sub>r = |h' \<turnstile> character_data_ptr_kinds_M|\<^sub>r"
|
||||
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:
|
||||
"reads (\<Union>node_ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t node_ptr RObject.nothing)}) character_data_ptr_kinds_M h h'"
|
||||
using node_ptr_kinds_M_reads
|
||||
apply(simp add: reads_def node_ptr_kinds_M_defs character_data_ptr_kinds_M_defs
|
||||
character_data_ptr_kinds_def preserved_def)
|
||||
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
|
||||
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]]
|
||||
|
||||
adhoc_overloading 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
|
||||
|
||||
locale 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 = 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
|
||||
begin
|
||||
sublocale l_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas by unfold_locales
|
||||
|
||||
interpretation 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(unfold_locales)
|
||||
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 local.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)
|
||||
by (meson CharacterDataMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas 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 = get_M_ok[folded 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]
|
||||
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
|
||||
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)
|
||||
|
||||
lemmas put_M_defs = a_put_M_def
|
||||
adhoc_overloading put_M 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
|
||||
|
||||
|
||||
locale l_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_lemmas = 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
|
||||
begin
|
||||
sublocale l_put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas by unfold_locales
|
||||
|
||||
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
|
||||
apply(unfold_locales)
|
||||
using 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_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.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 local.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
|
||||
apply blast
|
||||
by (meson CharacterDataMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas 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 = put_M_ok[folded 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_def]
|
||||
end
|
||||
|
||||
global_interpretation l_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_lemmas type_wf by unfold_locales
|
||||
|
||||
|
||||
|
||||
lemma CharacterData_simp1 [simp]:
|
||||
"(\<And>x. getter (setter (\<lambda>_. v) x) = v) \<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> h' \<turnstile> 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 \<rightarrow>\<^sub>r v"
|
||||
by(auto simp add: put_M_defs get_M_defs split: option.splits)
|
||||
lemma CharacterData_simp2 [simp]:
|
||||
"character_data_ptr \<noteq> character_data_ptr'
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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]: "
|
||||
(\<And>x. getter (setter (\<lambda>_. v) x) = getter x)
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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'")
|
||||
by(auto simp add: put_M_defs get_M_defs preserved_def split: option.splits dest: get_heap_E)
|
||||
lemma CharacterData_simp4 [simp]:
|
||||
"h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma CharacterData_simp5 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma CharacterData_simp6 [simp]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
bind_eq_Some_conv split: option.splits)
|
||||
lemma CharacterData_simp7 [simp]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
bind_eq_Some_conv split: option.splits)
|
||||
|
||||
lemma CharacterData_simp8 [simp]:
|
||||
"cast character_data_ptr \<noteq> node_ptr
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
preserved_def split: option.splits dest: get_heap_E)
|
||||
lemma CharacterData_simp9 [simp]:
|
||||
"h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'"
|
||||
apply(cases "cast character_data_ptr \<noteq> 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
|
||||
dest: get_heap_E)
|
||||
lemma CharacterData_simp10 [simp]:
|
||||
"cast character_data_ptr \<noteq> node_ptr
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
preserved_def split: option.splits dest: get_heap_E)
|
||||
|
||||
lemma CharacterData_simp11 [simp]:
|
||||
"cast character_data_ptr \<noteq> object_ptr
|
||||
\<Longrightarrow> h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
|
||||
lemma CharacterData_simp12 [simp]:
|
||||
"h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> 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 \<noteq> 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
|
||||
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
|
||||
split: option.splits bind_splits dest: get_heap_E)[1]
|
||||
|
||||
lemma CharacterData_simp13 [simp]:
|
||||
"cast character_data_ptr \<noteq> object_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
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:
|
||||
"h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
|
||||
subsection\<open>Creating CharacterData\<close>
|
||||
|
||||
definition new_character_data :: "(_, (_) character_data_ptr) dom_prog"
|
||||
where
|
||||
"new_character_data = do {
|
||||
h \<leftarrow> get_heap;
|
||||
(new_ptr, h') \<leftarrow> return (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);
|
||||
return_heap h';
|
||||
return new_ptr
|
||||
}"
|
||||
|
||||
lemma new_character_data_ok [simp]:
|
||||
"h \<turnstile> ok new_character_data"
|
||||
by(auto simp add: new_character_data_def split: prod.splits)
|
||||
|
||||
lemma new_character_data_ptr_in_heap:
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr"
|
||||
shows "new_character_data_ptr |\<in>| 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
|
||||
is_OK_returns_result_I
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_character_data_ptr_not_in_heap:
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr"
|
||||
shows "new_character_data_ptr |\<notin>| 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
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_character_data_new_ptr:
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|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
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_character_data_is_character_data_ptr:
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr"
|
||||
shows "is_character_data_ptr 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_is_character_data_ptr
|
||||
by(auto simp add: new_character_data_def elim!: bind_returns_result_E split: prod.splits)
|
||||
|
||||
lemma new_character_data_child_nodes:
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr"
|
||||
shows "h' \<turnstile> get_M new_character_data_ptr val \<rightarrow>\<^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
|
||||
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 \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr
|
||||
\<Longrightarrow> ptr \<noteq> cast new_character_data_ptr \<Longrightarrow> 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
|
||||
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 \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr
|
||||
\<Longrightarrow> ptr \<noteq> cast new_character_data_ptr \<Longrightarrow> 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
|
||||
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 \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr
|
||||
\<Longrightarrow> ptr \<noteq> new_character_data_ptr \<Longrightarrow> 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
|
||||
split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
|
||||
|
||||
subsection\<open>Modified Heaps\<close>
|
||||
|
||||
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 |\<union>|
|
||||
(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)
|
||||
|
||||
lemma type_wf_put_I:
|
||||
assumes "type_wf h"
|
||||
assumes "ElementClass.type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "is_character_data_ptr_kind ptr \<Longrightarrow> is_character_data_kind obj"
|
||||
shows "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs split: option.splits)
|
||||
|
||||
lemma type_wf_put_ptr_not_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<notin>| 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
|
||||
split: option.splits if_splits)
|
||||
using assms(2) node_ptr_kinds_commutes by blast
|
||||
|
||||
lemma type_wf_put_ptr_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
assumes "ElementClass.type_wf h"
|
||||
assumes "is_character_data_ptr_kind ptr \<Longrightarrow> is_character_data_kind (the (get ptr h))"
|
||||
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)
|
||||
|
||||
subsection\<open>Preserving Types\<close>
|
||||
|
||||
lemma new_element_type_wf_preserved [simp]:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^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
|
||||
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
|
||||
fimage_eqI is_element_ptr_ref)
|
||||
|
||||
lemma new_element_is_l_new_element: "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_type_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr tag_type_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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 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 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 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 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 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_child_nodes_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr child_nodes_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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 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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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]:
|
||||
"h \<turnstile> put_M element_ptr attrs_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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 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 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 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 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 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]:
|
||||
"h \<turnstile> put_M element_ptr shadow_root_opt_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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 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 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 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 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 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 new_character_data_type_wf_preserved [simp]:
|
||||
"h \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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)
|
||||
|
||||
locale l_new_character_data = l_type_wf +
|
||||
assumes new_character_data_types_preserved: "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
|
||||
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]:
|
||||
"h \<turnstile> put_M character_data_ptr val_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
split: option.splits)[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.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 finite_set_in)
|
||||
done
|
||||
|
||||
lemma character_data_ptr_kinds_small:
|
||||
assumes "\<And>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
|
||||
object_ptr_kinds_preserved_small[OF assms])
|
||||
|
||||
lemma character_data_ptr_kinds_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> (\<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')"
|
||||
shows "character_data_ptr_kinds h = character_data_ptr_kinds h'"
|
||||
using writes_small_big[OF assms]
|
||||
apply(simp add: reflp_def transp_def preserved_def character_data_ptr_kinds_def)
|
||||
by (metis assms node_ptr_kinds_preserved)
|
||||
|
||||
|
||||
lemma type_wf_preserved_small:
|
||||
assumes "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>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 "\<And>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)]
|
||||
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)]
|
||||
split: option.splits)[1]
|
||||
apply(force)
|
||||
by force
|
||||
|
||||
lemma type_wf_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 -
|
||||
have "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
using assms type_wf_preserved_small by fast
|
||||
with assms(1) assms(2) show ?thesis
|
||||
apply(rule writes_small_big)
|
||||
by(auto simp add: reflp_def transp_def)
|
||||
qed
|
||||
|
||||
lemma type_wf_drop: "type_wf h \<Longrightarrow> type_wf (Heap (fmdrop ptr (the_heap h)))"
|
||||
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)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/CharacterDataMonad.thy
|
|
@ -1,603 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Document\<close>
|
||||
text\<open>In this theory, we introduce the monadic method setup for the Document class.\<close>
|
||||
|
||||
theory DocumentMonad
|
||||
imports
|
||||
CharacterDataMonad
|
||||
"../classes/DocumentClass"
|
||||
begin
|
||||
|
||||
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"
|
||||
|
||||
|
||||
global_interpretation l_ptr_kinds_M document_ptr_kinds defines document_ptr_kinds_M = a_ptr_kinds_M .
|
||||
lemmas document_ptr_kinds_M_defs = a_ptr_kinds_M_def
|
||||
|
||||
lemma document_ptr_kinds_M_eq:
|
||||
assumes "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
|
||||
shows "|h \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
|
||||
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:
|
||||
"reads (\<Union>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 (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
|
||||
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]]
|
||||
|
||||
adhoc_overloading get_M get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
|
||||
locale l_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas = l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
sublocale 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 by unfold_locales
|
||||
|
||||
interpretation 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(unfold_locales)
|
||||
apply (simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf local.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
|
||||
by (meson DocumentMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok = get_M_ok[folded get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def]
|
||||
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
|
||||
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)
|
||||
|
||||
lemmas put_M_defs = a_put_M_def
|
||||
adhoc_overloading put_M put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
|
||||
|
||||
locale l_put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas = l_type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
sublocale l_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_lemmas by unfold_locales
|
||||
|
||||
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
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf local.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
|
||||
by (meson DocumentMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok = put_M_ok[folded put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def]
|
||||
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 \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (setter (\<lambda>_. v) x) = v)
|
||||
\<Longrightarrow> h' \<turnstile> get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr getter \<rightarrow>\<^sub>r v"
|
||||
by(auto simp add: put_M_defs get_M_defs split: option.splits)
|
||||
lemma get_M_Mdocument_preserved1 [simp]:
|
||||
"document_ptr \<noteq> document_ptr'
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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 \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (setter (\<lambda>_. v) x) = getter x)
|
||||
\<Longrightarrow> 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'")
|
||||
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]:
|
||||
"h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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 \<noteq> object_ptr
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
preserved_def split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Mdocument_preserved4 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> 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 \<noteq> 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
|
||||
split: option.splits bind_splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Mdocument_preserved5 [simp]:
|
||||
"cast document_ptr \<noteq> object_ptr
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
preserved_def split: option.splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Mdocument_preserved6 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Mdocument_preserved7 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Mdocument_preserved8 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Mdocument_preserved9 [simp]:
|
||||
"h \<turnstile> 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 \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Mdocument_preserved10 [simp]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: option.splits)
|
||||
|
||||
lemma new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t:
|
||||
"h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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:
|
||||
"h \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
|
||||
subsection \<open>Creating Documents\<close>
|
||||
|
||||
definition new_document :: "(_, (_) document_ptr) dom_prog"
|
||||
where
|
||||
"new_document = do {
|
||||
h \<leftarrow> get_heap;
|
||||
(new_ptr, h') \<leftarrow> return (new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t h);
|
||||
return_heap h';
|
||||
return new_ptr
|
||||
}"
|
||||
|
||||
lemma new_document_ok [simp]:
|
||||
"h \<turnstile> ok new_document"
|
||||
by(auto simp add: new_document_def split: prod.splits)
|
||||
|
||||
lemma new_document_ptr_in_heap:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "new_document_ptr |\<in>| document_ptr_kinds h'"
|
||||
using assms
|
||||
unfolding new_document_def
|
||||
by(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_ptr_in_heap is_OK_returns_result_I
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_document_ptr_not_in_heap:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "new_document_ptr |\<notin>| document_ptr_kinds h"
|
||||
using assms new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_not_in_heap
|
||||
by(auto simp add: new_document_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_document_new_ptr:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_document_ptr|}"
|
||||
using assms new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_new_ptr
|
||||
by(auto simp add: new_document_def split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_document_is_document_ptr:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "is_document_ptr new_document_ptr"
|
||||
using assms new\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_is_document_ptr
|
||||
by(auto simp add: new_document_def elim!: bind_returns_result_E split: prod.splits)
|
||||
|
||||
lemma new_document_doctype:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "h' \<turnstile> get_M new_document_ptr doctype \<rightarrow>\<^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
|
||||
split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_document_document_element:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "h' \<turnstile> get_M new_document_ptr document_element \<rightarrow>\<^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
|
||||
split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_document_disconnected_nodes:
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr"
|
||||
shows "h' \<turnstile> get_M new_document_ptr disconnected_nodes \<rightarrow>\<^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
|
||||
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 \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
|
||||
\<Longrightarrow> ptr \<noteq> cast new_document_ptr \<Longrightarrow> 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
|
||||
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 \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_document \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr \<Longrightarrow> ptr \<noteq> new_document_ptr
|
||||
\<Longrightarrow> 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)
|
||||
|
||||
|
||||
|
||||
subsection \<open>Modified Heaps\<close>
|
||||
|
||||
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)
|
||||
= document_ptr_kinds h |\<union>| (if is_document_ptr_kind ptr then {|the (cast ptr)|} else {||})"
|
||||
by(auto simp add: document_ptr_kinds_def split: option.splits)
|
||||
|
||||
lemma type_wf_put_I:
|
||||
assumes "type_wf h"
|
||||
assumes "CharacterDataClass.type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "is_document_ptr_kind ptr \<Longrightarrow> is_document_kind obj"
|
||||
shows "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs is_document_kind_def split: option.splits)
|
||||
|
||||
lemma type_wf_put_ptr_not_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<notin>| 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
|
||||
split: option.splits if_splits)
|
||||
|
||||
lemma type_wf_put_ptr_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
assumes "CharacterDataClass.type_wf h"
|
||||
assumes "is_document_ptr_kind ptr \<Longrightarrow> 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
|
||||
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)
|
||||
|
||||
|
||||
|
||||
subsection \<open>Preserving Types\<close>
|
||||
|
||||
lemma new_element_type_wf_preserved [simp]:
|
||||
"h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
split: if_splits)[1]
|
||||
apply fastforce
|
||||
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]:
|
||||
"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_type_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr tag_type_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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))
|
||||
by (metis fmember.rep_eq)
|
||||
|
||||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr child_nodes_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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))
|
||||
by (metis fmember.rep_eq)
|
||||
|
||||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr attrs_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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))
|
||||
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 \<turnstile> put_M element_ptr shadow_root_opt_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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))
|
||||
by (metis fmember.rep_eq)
|
||||
|
||||
lemma new_character_data_type_wf_preserved [simp]:
|
||||
"h \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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]:
|
||||
"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]:
|
||||
"h \<turnstile> put_M character_data_ptr val_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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
|
||||
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)
|
||||
by (metis finite_set_in)
|
||||
|
||||
|
||||
lemma new_document_type_wf_preserved [simp]: "h \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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)
|
||||
done
|
||||
|
||||
locale l_new_document = l_type_wf +
|
||||
assumes new_document_types_preserved: "h \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
|
||||
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]:
|
||||
"h \<turnstile> put_M document_ptr doctype_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
CharacterDataClass.type_wf_defs split: option.splits)[1]
|
||||
apply(auto simp add: get_M_defs)
|
||||
by (metis (mono_tags) error_returns_result finite_set_in option.exhaust_sel option.simps(4))
|
||||
|
||||
lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_document_element_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M document_ptr document_element_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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
|
||||
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]:
|
||||
"h \<turnstile> put_M document_ptr disconnected_nodes_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
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)
|
||||
|
||||
lemma document_ptr_kinds_small:
|
||||
assumes "\<And>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'"
|
||||
by(simp add: document_ptr_kinds_def preserved_def object_ptr_kinds_preserved_small[OF assms])
|
||||
|
||||
lemma document_ptr_kinds_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> (\<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')"
|
||||
shows "document_ptr_kinds h = document_ptr_kinds h'"
|
||||
using writes_small_big[OF assms]
|
||||
apply(simp add: reflp_def transp_def preserved_def document_ptr_kinds_def)
|
||||
by (metis assms object_ptr_kinds_preserved)
|
||||
|
||||
lemma type_wf_preserved_small:
|
||||
assumes "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>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 "\<And>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 "\<And>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)]
|
||||
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)]
|
||||
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)]
|
||||
split: option.splits)[1]
|
||||
by force
|
||||
|
||||
lemma type_wf_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 -
|
||||
have "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> DocumentClass.type_wf h = DocumentClass.type_wf h'"
|
||||
using assms type_wf_preserved_small by fast
|
||||
with assms(1) assms(2) show ?thesis
|
||||
apply(rule writes_small_big)
|
||||
by(auto simp add: reflp_def transp_def)
|
||||
qed
|
||||
|
||||
lemma type_wf_drop: "type_wf h \<Longrightarrow> type_wf (Heap (fmdrop ptr (the_heap h)))"
|
||||
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)
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/DocumentMonad.thy
|
|
@ -1,445 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Element\<close>
|
||||
text\<open>In this theory, we introduce the monadic method setup for the Element class.\<close>
|
||||
theory ElementMonad
|
||||
imports
|
||||
NodeMonad
|
||||
"ElementClass"
|
||||
begin
|
||||
|
||||
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"
|
||||
|
||||
|
||||
global_interpretation l_ptr_kinds_M element_ptr_kinds defines element_ptr_kinds_M = a_ptr_kinds_M .
|
||||
lemmas element_ptr_kinds_M_defs = a_ptr_kinds_M_def
|
||||
|
||||
|
||||
lemma element_ptr_kinds_M_eq:
|
||||
assumes "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
|
||||
shows "|h \<turnstile> element_ptr_kinds_M|\<^sub>r = |h' \<turnstile> element_ptr_kinds_M|\<^sub>r"
|
||||
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:
|
||||
"reads (\<Union>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)
|
||||
apply (metis (mono_tags, hide_lams) node_ptr_kinds_small old.unit.exhaust preserved_def)
|
||||
done
|
||||
|
||||
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
|
||||
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]]
|
||||
|
||||
adhoc_overloading get_M get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
|
||||
locale l_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas = l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
sublocale l_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas by unfold_locales
|
||||
|
||||
interpretation l_get_M get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t type_wf element_ptr_kinds
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf local.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
|
||||
by (meson ElementMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok = get_M_ok[folded get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def]
|
||||
lemmas get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap = get_M_ptr_in_heap[folded get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def]
|
||||
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"
|
||||
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)
|
||||
|
||||
lemmas put_M_defs = a_put_M_def
|
||||
adhoc_overloading put_M put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
|
||||
|
||||
locale l_put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas = l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
|
||||
begin
|
||||
sublocale l_put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas by unfold_locales
|
||||
|
||||
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
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_wf local.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
|
||||
by (meson ElementMonad.get_M_is_l_get_M l_get_M_def)
|
||||
|
||||
lemmas put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok = put_M_ok[folded put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def]
|
||||
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 \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> (\<And>x. getter (setter (\<lambda>_. v) x) = v)
|
||||
\<Longrightarrow> h' \<turnstile> get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr getter \<rightarrow>\<^sub>r v"
|
||||
by(auto simp add: put_M_defs get_M_defs split: option.splits)
|
||||
lemma get_M_Element_preserved1 [simp]:
|
||||
"element_ptr \<noteq> element_ptr' \<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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]:
|
||||
"(\<And>x. getter (setter (\<lambda>_. v) x) = getter x) \<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Element_preserved3 [simp]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: option.splits)
|
||||
lemma get_M_Element_preserved4 [simp]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
split: option.splits)
|
||||
|
||||
lemma get_M_Element_preserved5 [simp]:
|
||||
"cast element_ptr \<noteq> node_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Element_preserved6 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr getter) h h'"
|
||||
apply(cases "cast element_ptr \<noteq> 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
|
||||
split: option.splits bind_splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Element_preserved7 [simp]:
|
||||
"cast element_ptr \<noteq> node_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Element_preserved8 [simp]:
|
||||
"cast element_ptr \<noteq> object_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Element_preserved9 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> 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 \<noteq> 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
|
||||
split: option.splits bind_splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Element_preserved10 [simp]:
|
||||
"cast element_ptr \<noteq> object_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
|
||||
subsection\<open>Creating Elements\<close>
|
||||
|
||||
definition new_element :: "(_, (_) element_ptr) dom_prog"
|
||||
where
|
||||
"new_element = do {
|
||||
h \<leftarrow> get_heap;
|
||||
(new_ptr, h') \<leftarrow> return (new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t h);
|
||||
return_heap h';
|
||||
return new_ptr
|
||||
}"
|
||||
|
||||
lemma new_element_ok [simp]:
|
||||
"h \<turnstile> ok new_element"
|
||||
by(auto simp add: new_element_def split: prod.splits)
|
||||
|
||||
lemma new_element_ptr_in_heap:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "new_element_ptr |\<in>| element_ptr_kinds h'"
|
||||
using assms
|
||||
unfolding new_element_def
|
||||
by(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_ptr_in_heap is_OK_returns_result_I
|
||||
elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_element_ptr_not_in_heap:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "new_element_ptr |\<notin>| 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
|
||||
bind_returns_heap_E)
|
||||
|
||||
lemma new_element_new_ptr:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
and "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|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
|
||||
bind_returns_heap_E)
|
||||
|
||||
lemma new_element_is_element_ptr:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "is_element_ptr new_element_ptr"
|
||||
using assms new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_is_element_ptr
|
||||
by(auto simp add: new_element_def elim!: bind_returns_result_E split: prod.splits)
|
||||
|
||||
lemma new_element_child_nodes:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "h' \<turnstile> get_M new_element_ptr child_nodes \<rightarrow>\<^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
|
||||
split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_element_tag_type:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "h' \<turnstile> get_M new_element_ptr tag_type \<rightarrow>\<^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
|
||||
split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_element_attrs:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "h' \<turnstile> get_M new_element_ptr attrs \<rightarrow>\<^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
|
||||
split: option.splits prod.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
lemma new_element_shadow_root_opt:
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
|
||||
shows "h' \<turnstile> get_M new_element_ptr shadow_root_opt \<rightarrow>\<^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
|
||||
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 \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> ptr \<noteq> cast new_element_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> ptr \<noteq> cast new_element_ptr
|
||||
\<Longrightarrow> 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
|
||||
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 \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> ptr \<noteq> new_element_ptr
|
||||
\<Longrightarrow> 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
|
||||
split: prod.splits option.splits elim!: bind_returns_result_E bind_returns_heap_E)
|
||||
|
||||
subsection\<open>Modified Heaps\<close>
|
||||
|
||||
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)
|
||||
= element_ptr_kinds h |\<union>| (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)
|
||||
|
||||
lemma type_wf_put_I:
|
||||
assumes "type_wf h"
|
||||
assumes "NodeClass.type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "is_element_ptr_kind ptr \<Longrightarrow> is_element_kind obj"
|
||||
shows "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs split: option.splits)
|
||||
|
||||
lemma type_wf_put_ptr_not_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<notin>| 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
|
||||
split: option.splits if_splits)[1]
|
||||
using assms(2) node_ptr_kinds_commutes by blast
|
||||
|
||||
lemma type_wf_put_ptr_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
assumes "NodeClass.type_wf h"
|
||||
assumes "is_element_ptr_kind ptr \<Longrightarrow> is_element_kind (the (get ptr h))"
|
||||
shows "type_wf h"
|
||||
using assms
|
||||
apply(auto simp add: type_wf_defs split: option.splits if_splits)[1]
|
||||
by (metis (no_types, lifting) NodeClass.l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas_axioms assms(2) bind.bind_lunit
|
||||
cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def
|
||||
l_get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf option.collapse)
|
||||
|
||||
subsection\<open>Preserving Types\<close>
|
||||
|
||||
lemma new_element_type_wf_preserved [simp]: "h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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
|
||||
is_element_ptr_ref)
|
||||
apply (metis element_ptrs_def fempty_iff ffmember_filter finite_set_in is_element_ptr_ref)
|
||||
apply (metis (no_types, lifting) Suc_n_not_le_n element_ptr.sel(1) element_ptr_kinds_commutes
|
||||
element_ptrs_def fMax_ge ffmember_filter fimage_eqI is_element_ptr_ref notin_fset)
|
||||
apply (metis (no_types, lifting) Suc_n_not_le_n element_ptr.sel(1) element_ptrs_def
|
||||
fMax_ge ffmember_filter fimage_eqI finite_set_in is_element_ptr_ref)
|
||||
done
|
||||
|
||||
locale l_new_element = l_type_wf +
|
||||
assumes new_element_types_preserved: "h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
|
||||
lemma new_element_is_l_new_element: "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_type_type_wf_preserved [simp]:
|
||||
"h \<turnstile> put_M element_ptr tag_type_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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]:
|
||||
"h \<turnstile> put_M element_ptr child_nodes_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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]:
|
||||
"h \<turnstile> put_M element_ptr attrs_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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]:
|
||||
"h \<turnstile> put_M element_ptr shadow_root_opt_update v \<rightarrow>\<^sub>h h' \<Longrightarrow> 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
|
||||
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_pointers_preserved:
|
||||
assumes "h \<turnstile> put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr setter v \<rightarrow>\<^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
|
||||
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 \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> (\<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')"
|
||||
shows "element_ptr_kinds h = element_ptr_kinds h'"
|
||||
using writes_small_big[OF assms]
|
||||
apply(simp add: reflp_def transp_def preserved_def element_ptr_kinds_def)
|
||||
by (metis assms node_ptr_kinds_preserved)
|
||||
|
||||
|
||||
lemma element_ptr_kinds_small:
|
||||
assumes "\<And>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
|
||||
object_ptr_kinds_preserved_small[OF assms])
|
||||
|
||||
lemma type_wf_preserved_small:
|
||||
assumes "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>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'"
|
||||
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)]
|
||||
split: option.splits,force)[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 \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>node_ptr. preserved (get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr RNode.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 -
|
||||
have "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
using assms type_wf_preserved_small by fast
|
||||
with assms(1) assms(2) show ?thesis
|
||||
apply(rule writes_small_big)
|
||||
by(auto simp add: reflp_def transp_def)
|
||||
qed
|
||||
|
||||
lemma type_wf_drop: "type_wf h \<Longrightarrow> 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
|
||||
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)
|
||||
by (metis element_ptr_kinds_commutes fmdom_notI fmdrop_lookup heap.sel node_ptr_kinds_commutes
|
||||
o_apply object_ptr_kinds_def)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/ElementMonad.thy
|
|
@ -1,218 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Node\<close>
|
||||
text\<open>In this theory, we introduce the monadic method setup for the Node class.\<close>
|
||||
theory NodeMonad
|
||||
imports
|
||||
ObjectMonad
|
||||
"../classes/NodeClass"
|
||||
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"
|
||||
|
||||
|
||||
global_interpretation l_ptr_kinds_M node_ptr_kinds defines node_ptr_kinds_M = a_ptr_kinds_M .
|
||||
lemmas node_ptr_kinds_M_defs = a_ptr_kinds_M_def
|
||||
|
||||
lemma node_ptr_kinds_M_eq:
|
||||
assumes "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
|
||||
shows "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
|
||||
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
|
||||
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]]
|
||||
|
||||
adhoc_overloading get_M get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
|
||||
locale l_get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas = l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
begin
|
||||
sublocale l_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas by unfold_locales
|
||||
|
||||
interpretation l_get_M get\<^sub>N\<^sub>o\<^sub>d\<^sub>e type_wf node_ptr_kinds
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf local.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e)
|
||||
by (meson NodeMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ok = get_M_ok[folded get_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def]
|
||||
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:
|
||||
"reads (\<Union>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"
|
||||
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)
|
||||
|
||||
lemmas put_M_defs = a_put_M_def
|
||||
adhoc_overloading put_M put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
|
||||
|
||||
locale l_put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_lemmas = l_type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e
|
||||
begin
|
||||
sublocale l_put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas by unfold_locales
|
||||
|
||||
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
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf local.type_wf\<^sub>N\<^sub>o\<^sub>d\<^sub>e)
|
||||
by (meson NodeMonad.get_M_is_l_get_M l_get_M_def)
|
||||
lemmas put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_ok = put_M_ok[folded put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def]
|
||||
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]:
|
||||
"(\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x)) \<Longrightarrow> h \<turnstile> put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits)
|
||||
|
||||
lemma get_M_Object_preserved2 [simp]:
|
||||
"cast node_ptr \<noteq> object_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
lemma get_M_Object_preserved3 [simp]:
|
||||
"h \<turnstile> put_M\<^sub>N\<^sub>o\<^sub>d\<^sub>e node_ptr setter v \<rightarrow>\<^sub>h h' \<Longrightarrow> (\<And>x. getter (cast (setter (\<lambda>_. v) x)) = getter (cast x))
|
||||
\<Longrightarrow> 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 \<noteq> 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
|
||||
split: option.splits bind_splits dest: get_heap_E)
|
||||
|
||||
lemma get_M_Object_preserved4 [simp]:
|
||||
"cast node_ptr \<noteq> object_ptr \<Longrightarrow> h \<turnstile> put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr setter v \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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
|
||||
split: option.splits dest: get_heap_E)
|
||||
|
||||
subsection\<open>Modified Heaps\<close>
|
||||
|
||||
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)
|
||||
= node_ptr_kinds h |\<union>| (if is_node_ptr_kind ptr then {|the (cast ptr)|} else {||})"
|
||||
by(auto simp add: node_ptr_kinds_def)
|
||||
|
||||
lemma type_wf_put_I:
|
||||
assumes "type_wf h"
|
||||
assumes "ObjectClass.type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "is_node_ptr_kind ptr \<Longrightarrow> is_node_kind obj"
|
||||
shows "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
using assms
|
||||
apply(auto simp add: type_wf_defs split: option.splits)[1]
|
||||
using cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none is_node_kind_def apply blast
|
||||
using cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_none is_node_kind_def apply blast
|
||||
done
|
||||
|
||||
lemma type_wf_put_ptr_not_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<notin>| 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
|
||||
split: option.splits if_splits)
|
||||
|
||||
lemma type_wf_put_ptr_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
assumes "ObjectClass.type_wf h"
|
||||
assumes "is_node_ptr_kind ptr \<Longrightarrow> is_node_kind (the (get ptr h))"
|
||||
shows "type_wf h"
|
||||
using assms
|
||||
apply(auto simp add: type_wf_defs split: option.splits if_splits)
|
||||
by (metis ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit finite_set_in get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def is_node_kind_def option.exhaust_sel)
|
||||
|
||||
|
||||
subsection\<open>Preserving Types\<close>
|
||||
|
||||
lemma node_ptr_kinds_small:
|
||||
assumes "\<And>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'"
|
||||
by(simp add: node_ptr_kinds_def preserved_def object_ptr_kinds_preserved_small[OF assms])
|
||||
|
||||
lemma node_ptr_kinds_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<longrightarrow> (\<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h')"
|
||||
shows "node_ptr_kinds h = node_ptr_kinds h'"
|
||||
using writes_small_big[OF assms]
|
||||
apply(simp add: reflp_def transp_def preserved_def node_ptr_kinds_def)
|
||||
by (metis assms object_ptr_kinds_preserved)
|
||||
|
||||
|
||||
lemma type_wf_preserved_small:
|
||||
assumes "\<And>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>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'"
|
||||
using type_wf_preserved allI[OF assms(2), of id, simplified]
|
||||
apply(auto simp add: type_wf_defs)
|
||||
apply(auto simp add: preserved_def get_M_defs node_ptr_kinds_small[OF assms(1)]
|
||||
split: option.splits)[1]
|
||||
apply (metis notin_fset option.simps(3))
|
||||
by(auto simp add: preserved_def get_M_defs node_ptr_kinds_small[OF assms(1)]
|
||||
split: option.splits, force)[1]
|
||||
|
||||
lemma type_wf_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>object_ptr. preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> \<forall>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 -
|
||||
have "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
|
||||
using assms type_wf_preserved_small by fast
|
||||
with assms(1) assms(2) show ?thesis
|
||||
apply(rule writes_small_big)
|
||||
by(auto simp add: reflp_def transp_def)
|
||||
qed
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/NodeMonad.thy
|
|
@ -1,258 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Object\<close>
|
||||
text\<open>In this theory, we introduce the monadic method setup for the Object class.\<close>
|
||||
theory ObjectMonad
|
||||
imports
|
||||
BaseMonad
|
||||
"../classes/ObjectClass"
|
||||
begin
|
||||
|
||||
type_synonym ('object_ptr, 'Object, 'result) dom_prog
|
||||
= "((_) heap, exception, 'result) 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
|
||||
|
||||
|
||||
global_interpretation l_dummy defines get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t = "l_get_M.a_get_M get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t" .
|
||||
lemma get_M_is_l_get_M: "l_get_M get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t type_wf object_ptr_kinds"
|
||||
by (simp add: a_type_wf_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf l_get_M_def)
|
||||
lemmas get_M_defs = get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def[unfolded l_get_M.a_get_M_def[OF get_M_is_l_get_M]]
|
||||
|
||||
adhoc_overloading get_M get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
|
||||
locale l_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas = l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
begin
|
||||
interpretation l_get_M get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t type_wf object_ptr_kinds
|
||||
apply(unfold_locales)
|
||||
apply (simp add: get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf local.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t)
|
||||
by (simp add: a_type_wf_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf)
|
||||
lemmas get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok = get_M_ok[folded get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def]
|
||||
lemmas get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap = get_M_ptr_in_heap[folded get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def]
|
||||
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:
|
||||
"reads (\<Union>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
|
||||
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"
|
||||
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)
|
||||
lemmas put_M_defs = a_put_M_def
|
||||
adhoc_overloading put_M put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
|
||||
|
||||
locale l_put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas = l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
|
||||
begin
|
||||
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
|
||||
apply(unfold_locales)
|
||||
using get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t local.l_type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_axioms apply blast
|
||||
by (simp add: a_type_wf_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf)
|
||||
lemmas put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ok = put_M_ok[folded put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def]
|
||||
lemmas put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_ptr_in_heap = put_M_ptr_in_heap[folded put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def]
|
||||
end
|
||||
|
||||
global_interpretation l_put_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_lemmas type_wf
|
||||
by (simp add: l_put_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)
|
||||
|
||||
|
||||
definition check_in_heap :: "(_) object_ptr \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"check_in_heap ptr = do {
|
||||
h \<leftarrow> get_heap;
|
||||
(if ptr |\<in>| object_ptr_kinds h then
|
||||
return ()
|
||||
else
|
||||
error SegmentationFault
|
||||
)}"
|
||||
|
||||
lemma check_in_heap_ptr_in_heap: "ptr |\<in>| object_ptr_kinds h \<longleftrightarrow> h \<turnstile> ok (check_in_heap ptr)"
|
||||
by(auto simp add: check_in_heap_def)
|
||||
lemma check_in_heap_pure [simp]: "pure (check_in_heap ptr) h"
|
||||
by(auto simp add: check_in_heap_def intro!: bind_pure_I)
|
||||
lemma check_in_heap_is_OK [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (check_in_heap ptr \<bind> f) = h \<turnstile> ok (f ())"
|
||||
by(simp add: check_in_heap_def)
|
||||
lemma check_in_heap_returns_result [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> h \<turnstile> (check_in_heap ptr \<bind> f) \<rightarrow>\<^sub>r x = h \<turnstile> f () \<rightarrow>\<^sub>r x"
|
||||
by(simp add: check_in_heap_def)
|
||||
lemma check_in_heap_returns_heap [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> h \<turnstile> (check_in_heap ptr \<bind> f) \<rightarrow>\<^sub>h h' = h \<turnstile> f () \<rightarrow>\<^sub>h h'"
|
||||
by(simp add: check_in_heap_def)
|
||||
|
||||
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
|
||||
is_OK_returns_result_I unit_all_impI)
|
||||
|
||||
subsection\<open>Invoke\<close>
|
||||
|
||||
fun invoke_rec :: "(((_) object_ptr \<Rightarrow> bool) \<times> ((_) object_ptr \<Rightarrow> 'args
|
||||
\<Rightarrow> (_, 'result) dom_prog)) list \<Rightarrow> (_) object_ptr \<Rightarrow> 'args
|
||||
\<Rightarrow> (_, '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 \<Rightarrow> bool) \<times> ((_) object_ptr \<Rightarrow> 'args
|
||||
\<Rightarrow> (_, 'result) dom_prog)) list
|
||||
\<Rightarrow> (_) object_ptr \<Rightarrow> 'args \<Rightarrow> (_, 'result) dom_prog"
|
||||
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) =
|
||||
((\<not>(Pred ptr) \<longrightarrow> P (invoke xs ptr args))
|
||||
\<and> (Pred ptr \<longrightarrow> P (do {check_in_heap ptr; f ptr args})))"
|
||||
by(simp add: invoke_def)
|
||||
|
||||
lemma invoke_split_asm: "P (invoke ((Pred, f) # xs) ptr args) =
|
||||
(\<not>((\<not>(Pred ptr) \<and> (\<not> P (invoke xs ptr args)))
|
||||
\<or> (Pred ptr \<and> (\<not> P (do {check_in_heap ptr; f ptr args})))))"
|
||||
by(simp add: invoke_def)
|
||||
lemmas invoke_splits = invoke_split invoke_split_asm
|
||||
|
||||
lemma invoke_ptr_in_heap: "h \<turnstile> ok (invoke xs ptr args) \<Longrightarrow> ptr |\<in>| object_ptr_kinds h"
|
||||
by (metis bind_is_OK_E check_in_heap_ptr_in_heap invoke_def is_OK_returns_heap_I)
|
||||
|
||||
lemma invoke_pure [simp]: "pure (invoke [] ptr args) h"
|
||||
by(auto simp add: invoke_def intro!: bind_pure_I)
|
||||
|
||||
lemma invoke_is_OK [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> Pred ptr
|
||||
\<Longrightarrow> h \<turnstile> ok (invoke ((Pred, f) # xs) ptr args) = h \<turnstile> ok (f ptr args)"
|
||||
by(simp add: invoke_def)
|
||||
lemma invoke_returns_result [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> Pred ptr
|
||||
\<Longrightarrow> h \<turnstile> (invoke ((Pred, f) # xs) ptr args) \<rightarrow>\<^sub>r x = h \<turnstile> f ptr args \<rightarrow>\<^sub>r x"
|
||||
by(simp add: invoke_def)
|
||||
lemma invoke_returns_heap [simp]:
|
||||
"ptr |\<in>| object_ptr_kinds h \<Longrightarrow> Pred ptr
|
||||
\<Longrightarrow> h \<turnstile> (invoke ((Pred, f) # xs) ptr args) \<rightarrow>\<^sub>h h' = h \<turnstile> f ptr args \<rightarrow>\<^sub>h h'"
|
||||
by(simp add: invoke_def)
|
||||
|
||||
lemma invoke_not [simp]: "\<not>Pred ptr \<Longrightarrow> invoke ((Pred, f) # xs) ptr args = invoke xs ptr args"
|
||||
by(auto simp add: invoke_def)
|
||||
|
||||
lemma invoke_empty [simp]: "\<not>h \<turnstile> ok (invoke [] ptr args)"
|
||||
by(auto simp add: invoke_def check_in_heap_def)
|
||||
|
||||
lemma invoke_empty_reads [simp]: "\<forall>P \<in> S. reflp P \<and> transp P \<Longrightarrow> reads S (invoke [] ptr args) h h'"
|
||||
apply(simp add: invoke_def reads_def preserved_def)
|
||||
by (meson bind_returns_result_E error_returns_result)
|
||||
|
||||
|
||||
subsection\<open>Modified Heaps\<close>
|
||||
|
||||
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)
|
||||
|
||||
lemma object_ptr_kinds_simp [simp]: "object_ptr_kinds (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h) = object_ptr_kinds h |\<union>| {|ptr|}"
|
||||
by(auto simp add: object_ptr_kinds_def put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: option.splits)
|
||||
|
||||
lemma type_wf_put_I:
|
||||
assumes "type_wf h"
|
||||
shows "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs split: option.splits)
|
||||
|
||||
lemma type_wf_put_ptr_not_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<notin>| object_ptr_kinds h"
|
||||
shows "type_wf h"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs split: option.splits if_splits)
|
||||
|
||||
lemma type_wf_put_ptr_in_heap_E:
|
||||
assumes "type_wf (put\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr obj h)"
|
||||
assumes "ptr |\<in>| object_ptr_kinds h"
|
||||
shows "type_wf h"
|
||||
using assms
|
||||
by(auto simp add: type_wf_defs split: option.splits if_splits)
|
||||
|
||||
|
||||
subsection\<open>Preserving Types\<close>
|
||||
|
||||
lemma type_wf_preserved: "type_wf h = type_wf h'"
|
||||
by(auto simp add: type_wf_defs)
|
||||
|
||||
|
||||
lemma object_ptr_kinds_preserved_small:
|
||||
assumes "\<And>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
|
||||
split: option.splits)[1]
|
||||
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
|
||||
old.unit.exhaust option.case_eq_if return_returns_result)
|
||||
|
||||
lemma object_ptr_kinds_preserved:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w object_ptr. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h'
|
||||
\<Longrightarrow> 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 -
|
||||
{
|
||||
fix object_ptr w
|
||||
have "preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t object_ptr RObject.nothing) h h'"
|
||||
apply(rule writes_small_big[OF assms])
|
||||
by auto
|
||||
}
|
||||
then show ?thesis
|
||||
using object_ptr_kinds_preserved_small by blast
|
||||
qed
|
||||
|
||||
|
||||
lemma reads_writes_preserved2:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' x. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr getter) h h'"
|
||||
shows "preserved (get_M ptr getter) h h'"
|
||||
apply(clarsimp simp add: preserved_def)
|
||||
using reads_singleton assms(1) assms(2)
|
||||
apply(rule reads_writes_preserved)
|
||||
using assms(3)
|
||||
by(auto simp add: preserved_def)
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/monads/ObjectMonad.thy
|
|
@ -1,199 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>CharacterData\<close>
|
||||
text\<open>In this theory, we introduce the typed pointers for the class CharacterData.\<close>
|
||||
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"
|
||||
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"
|
||||
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"
|
||||
|
||||
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 \<Rightarrow> (_) node_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 ptr = node_ptr.Ext (Inr (Inl ptr))"
|
||||
|
||||
abbreviation 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 :: "(_) character_data_ptr \<Rightarrow> (_) object_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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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>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 ptr)"
|
||||
|
||||
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 \<Rightarrow> (_) 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
|
||||
node_ptr.Ext (Inr (Inl character_data_ptr)) \<Rightarrow> Some character_data_ptr
|
||||
| _ \<Rightarrow> 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>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 :: "(_) object_ptr \<Rightarrow> (_) character_data_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>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 \<equiv> (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of
|
||||
Some node_ptr \<Rightarrow> 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 \<Rightarrow> 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
|
||||
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 \<Rightarrow> 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
|
||||
of Some _ \<Rightarrow> True | _ \<Rightarrow> 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 \<Rightarrow> 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 \<equiv> (case cast ptr of
|
||||
Some node_ptr \<Rightarrow> is_character_data_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr
|
||||
| None \<Rightarrow> 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
|
||||
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 \<Rightarrow> 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
|
||||
of character_data_ptr.Ref _ \<Rightarrow> True | _ \<Rightarrow> False)"
|
||||
|
||||
abbreviation is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (case cast ptr of
|
||||
Some character_data_ptr \<Rightarrow> 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
|
||||
| _ \<Rightarrow> False)"
|
||||
|
||||
abbreviation is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of
|
||||
Some node_ptr \<Rightarrow> is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr
|
||||
| None \<Rightarrow> False)"
|
||||
|
||||
adhoc_overloading is_character_data_ptr
|
||||
is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_character_data_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r 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
|
||||
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
|
||||
"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 \<equiv> \<not> 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 \<equiv> (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 character_data_ptr \<Rightarrow> 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 character_data_ptr
|
||||
| None \<Rightarrow> False)"
|
||||
|
||||
abbreviation "is_character_data_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of
|
||||
Some node_ptr \<Rightarrow> is_character_data_ptr_ext\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr
|
||||
| None \<Rightarrow> False)"
|
||||
|
||||
adhoc_overloading is_character_data_ptr_ext
|
||||
is_character_data_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_character_data_ptr_ext\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r 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
|
||||
|
||||
instantiation character_data_ptr :: (linorder) linorder
|
||||
begin
|
||||
definition
|
||||
less_eq_character_data_ptr :: "(_::linorder) character_data_ptr \<Rightarrow> (_) character_data_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"less_eq_character_data_ptr x y \<equiv> (case x of Ext i \<Rightarrow> (case y of Ext j \<Rightarrow> i \<le> j | Ref _ \<Rightarrow> False)
|
||||
| Ref i \<Rightarrow> (case y of Ext _ \<Rightarrow> True | Ref j \<Rightarrow> i \<le> j))"
|
||||
definition
|
||||
less_character_data_ptr :: "(_::linorder) character_data_ptr \<Rightarrow> (_) character_data_ptr \<Rightarrow> bool"
|
||||
where "less_character_data_ptr x y \<equiv> x \<le> y \<and> \<not> y \<le> x"
|
||||
instance
|
||||
apply(standard)
|
||||
by(auto simp add: less_eq_character_data_ptr_def less_character_data_ptr_def
|
||||
split: character_data_ptr.splits)
|
||||
end
|
||||
|
||||
lemma is_character_data_ptr_ref [simp]: "is_character_data_ptr (character_data_ptr.Ref n)"
|
||||
by(simp add: 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)
|
||||
|
||||
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 \<noteq> 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 \<noteq> cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>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
|
||||
by(auto)
|
||||
|
||||
lemma is_character_data_ptr_kind_not_element_ptr [simp]:
|
||||
"\<not> 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]:
|
||||
"\<not> 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]:
|
||||
"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
|
||||
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]:
|
||||
"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 = Some character_data_ptr
|
||||
\<longleftrightarrow> 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"
|
||||
unfolding 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
|
||||
by(auto split: node_ptr.splits sum.splits)
|
||||
|
||||
lemma character_data_ptr_casts_commute2 [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 (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) = Some character_data_ptr)"
|
||||
by simp
|
||||
|
||||
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
|
||||
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
|
||||
character_data_ptr_casts_commute)
|
||||
|
||||
lemma is_character_data_ptr_kind_none:
|
||||
assumes "\<not>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>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"
|
||||
using assms
|
||||
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]:
|
||||
"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 \<longleftrightarrow> 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]:
|
||||
"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)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/CharacterDataPointer.thy
|
|
@ -1,154 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Document\<close>
|
||||
text\<open>In this theory, we introduce the typed pointers for the class Document.\<close>
|
||||
theory DocumentPointer
|
||||
imports
|
||||
CharacterDataPointer
|
||||
begin
|
||||
|
||||
datatype 'document_ptr document_ptr = Ref (the_ref: ref) | Ext '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"
|
||||
|
||||
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 \<Rightarrow> (_) object_ptr"
|
||||
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>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = object_ptr.Ext (Inr (Inl ptr))"
|
||||
|
||||
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 \<Rightarrow> (_) 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)) \<Rightarrow> Some document_ptr
|
||||
| _ \<Rightarrow> 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
|
||||
|
||||
|
||||
definition is_document_ptr_kind :: "(_) object_ptr \<Rightarrow> 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
|
||||
Some _ \<Rightarrow> True | None \<Rightarrow> False)"
|
||||
|
||||
consts is_document_ptr :: 'a
|
||||
definition is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) document_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of document_ptr.Ref _ \<Rightarrow> True | _ \<Rightarrow> False)"
|
||||
|
||||
abbreviation is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (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 \<Rightarrow> is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr
|
||||
| None \<Rightarrow> False)"
|
||||
adhoc_overloading is_document_ptr is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r
|
||||
lemmas is_document_ptr_def = is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
|
||||
|
||||
consts is_document_ptr_ext :: 'a
|
||||
abbreviation "is_document_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 \<equiv> \<not> is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
|
||||
|
||||
abbreviation "is_document_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (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 \<Rightarrow> is_document_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 document_ptr
|
||||
| None \<Rightarrow> False)"
|
||||
adhoc_overloading is_document_ptr_ext is_document_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_document_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 document_ptr :: (linorder) linorder
|
||||
begin
|
||||
definition less_eq_document_ptr :: "(_::linorder) document_ptr \<Rightarrow> (_) document_ptr \<Rightarrow> bool"
|
||||
where "less_eq_document_ptr x y \<equiv> (case x of Ext i \<Rightarrow> (case y of Ext j \<Rightarrow> i \<le> j | Ref _ \<Rightarrow> False)
|
||||
| Ref i \<Rightarrow> (case y of Ext _ \<Rightarrow> True | Ref j \<Rightarrow> i \<le> j))"
|
||||
definition less_document_ptr :: "(_::linorder) document_ptr \<Rightarrow> (_) document_ptr \<Rightarrow> bool"
|
||||
where "less_document_ptr x y \<equiv> x \<le> y \<and> \<not> y \<le> x"
|
||||
instance
|
||||
apply(standard)
|
||||
by(auto simp add: less_eq_document_ptr_def less_document_ptr_def split: document_ptr.splits)
|
||||
end
|
||||
|
||||
lemma is_document_ptr_ref [simp]: "is_document_ptr (document_ptr.Ref n)"
|
||||
by(simp add: is_document_ptr\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def)
|
||||
|
||||
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 \<noteq> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \<noteq> cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r document_ptr"
|
||||
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]:
|
||||
"\<not> 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]:
|
||||
"\<not> 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]:
|
||||
"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)
|
||||
|
||||
lemma document_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>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = Some document_ptr \<longleftrightarrow> 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"
|
||||
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]:
|
||||
"(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
|
||||
|
||||
lemma document_ptr_casts_commute3 [simp]:
|
||||
assumes "is_document_ptr_kind ptr"
|
||||
shows "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 (the (cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)) = ptr"
|
||||
using assms
|
||||
by(auto simp add: is_document_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>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
|
||||
split: object_ptr.splits sum.splits)
|
||||
|
||||
lemma is_document_ptr_kind_obtains:
|
||||
assumes "is_document_ptr_kind ptr"
|
||||
obtains document_ptr where "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"
|
||||
using assms is_document_ptr_kind_def
|
||||
by (metis case_optionE document_ptr_casts_commute)
|
||||
|
||||
lemma is_document_ptr_kind_none:
|
||||
assumes "\<not>is_document_ptr_kind ptr"
|
||||
shows "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 = None"
|
||||
using assms
|
||||
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]:
|
||||
"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 \<longleftrightarrow> 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]:
|
||||
"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)
|
||||
|
||||
lemma is_document_ptr_kind_not_element_ptr_kind [dest]:
|
||||
"is_document_ptr_kind ptr \<Longrightarrow> \<not> is_element_ptr_kind ptr"
|
||||
by(auto simp add: split: option.splits)
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/DocumentPointer.thy
|
|
@ -1,178 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Element\<close>
|
||||
text\<open>In this theory, we introduce the typed pointers for the class Element.\<close>
|
||||
theory ElementPointer
|
||||
imports
|
||||
NodePointer
|
||||
begin
|
||||
|
||||
datatype 'element_ptr element_ptr = Ref (the_ref: ref) | Ext '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"
|
||||
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"
|
||||
|
||||
|
||||
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 \<Rightarrow> (_) element_ptr"
|
||||
where
|
||||
"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 = id"
|
||||
|
||||
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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) element_ptr \<Rightarrow> (_) node_ptr"
|
||||
where
|
||||
"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 ptr = node_ptr.Ext (Inl ptr)"
|
||||
|
||||
abbreviation cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) element_ptr \<Rightarrow> (_) object_ptr"
|
||||
where
|
||||
"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 ptr \<equiv> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)"
|
||||
|
||||
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 \<Rightarrow> (_) 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)
|
||||
\<Rightarrow> Some element_ptr | _ \<Rightarrow> 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 \<Rightarrow> (_) 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 \<equiv> (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of
|
||||
Some node_ptr \<Rightarrow> 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 \<Rightarrow> 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
|
||||
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
|
||||
definition is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_element_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>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of Some _ \<Rightarrow> True | _ \<Rightarrow> False)"
|
||||
|
||||
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 \<Rightarrow> 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 \<equiv> (case cast ptr of
|
||||
Some node_ptr \<Rightarrow> is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr
|
||||
| None \<Rightarrow> 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
|
||||
lemmas is_element_ptr_kind_def = is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
|
||||
|
||||
consts is_element_ptr :: 'a
|
||||
definition 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 \<Rightarrow> bool"
|
||||
where
|
||||
"is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = (case ptr of element_ptr.Ref _ \<Rightarrow> True | _ \<Rightarrow> False)"
|
||||
|
||||
abbreviation is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) node_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> 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
|
||||
| _ \<Rightarrow> 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 \<Rightarrow> 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 \<equiv> (case cast ptr of
|
||||
Some node_ptr \<Rightarrow> is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr
|
||||
| None \<Rightarrow> 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
|
||||
lemmas is_element_ptr_def = is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
|
||||
|
||||
consts is_element_ptr_ext :: 'a
|
||||
abbreviation "is_element_ptr_ext\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> \<not> is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
|
||||
|
||||
abbreviation "is_element_ptr_ext\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> is_element_ptr_kind ptr \<and> (\<not> is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)"
|
||||
|
||||
abbreviation "is_element_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<equiv> is_element_ptr_kind ptr \<and> (\<not> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr)"
|
||||
adhoc_overloading is_element_ptr_ext is_element_ptr_ext\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r is_element_ptr_ext\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r
|
||||
|
||||
|
||||
instantiation element_ptr :: (linorder) linorder
|
||||
begin
|
||||
definition
|
||||
less_eq_element_ptr :: "(_::linorder) element_ptr \<Rightarrow> (_)element_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"less_eq_element_ptr x y \<equiv> (case x of Ext i \<Rightarrow> (case y of Ext j \<Rightarrow> i \<le> j | Ref _ \<Rightarrow> False)
|
||||
| Ref i \<Rightarrow> (case y of Ext _ \<Rightarrow> True | Ref j \<Rightarrow> i \<le> j))"
|
||||
definition
|
||||
less_element_ptr :: "(_::linorder) element_ptr \<Rightarrow> (_) element_ptr \<Rightarrow> bool"
|
||||
where "less_element_ptr x y \<equiv> x \<le> y \<and> \<not> y \<le> x"
|
||||
instance
|
||||
apply(standard)
|
||||
by(auto simp add: less_eq_element_ptr_def less_element_ptr_def split: element_ptr.splits)
|
||||
end
|
||||
|
||||
lemma is_element_ptr_ref [simp]: "is_element_ptr (element_ptr.Ref n)"
|
||||
by(simp add: is_element_ptr\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def)
|
||||
|
||||
lemma element_ptr_casts_commute [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 = Some element_ptr \<longleftrightarrow> 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 = node_ptr"
|
||||
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]:
|
||||
"(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
|
||||
|
||||
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
|
||||
split: node_ptr.splits sum.splits)
|
||||
|
||||
lemma is_element_ptr_kind_obtains:
|
||||
assumes "is_element_ptr_kind node_ptr"
|
||||
obtains element_ptr where "node_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"
|
||||
by (metis assms is_element_ptr_kind_def case_optionE element_ptr_casts_commute)
|
||||
|
||||
lemma is_element_ptr_kind_none:
|
||||
assumes "\<not>is_element_ptr_kind node_ptr"
|
||||
shows "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"
|
||||
using assms
|
||||
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]:
|
||||
"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]:
|
||||
"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 \<longleftrightarrow> 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]:
|
||||
"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)
|
||||
|
||||
lemma is_element_ptr_implies_kind [dest]: "is_element_ptr\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<Longrightarrow> is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
|
||||
by(auto split: option.splits)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/ElementPointer.thy
|
|
@ -1,111 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Node\<close>
|
||||
text\<open>In this theory, we introduce the typed pointers for the class Node.\<close>
|
||||
theory NodePointer
|
||||
imports
|
||||
ObjectPointer
|
||||
begin
|
||||
|
||||
datatype 'node_ptr node_ptr = Ext '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"
|
||||
|
||||
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 \<Rightarrow> (_) object_ptr"
|
||||
where
|
||||
"cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr = object_ptr.Ext (Inl ptr)"
|
||||
|
||||
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 \<Rightarrow> (_) 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)
|
||||
\<Rightarrow> Some node_ptr | _ \<Rightarrow> 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
|
||||
|
||||
definition is_node_ptr_kind :: "(_) object_ptr \<Rightarrow> bool"
|
||||
where
|
||||
"is_node_ptr_kind 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 ptr \<noteq> None)"
|
||||
|
||||
instantiation node_ptr :: (linorder) linorder
|
||||
begin
|
||||
definition less_eq_node_ptr :: "(_::linorder) node_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> bool"
|
||||
where "less_eq_node_ptr x y \<equiv> (case x of Ext i \<Rightarrow> (case y of Ext j \<Rightarrow> i \<le> j))"
|
||||
definition less_node_ptr :: "(_::linorder) node_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> bool"
|
||||
where "less_node_ptr x y \<equiv> x \<le> y \<and> \<not> y \<le> x"
|
||||
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]:
|
||||
"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 \<longleftrightarrow> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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]:
|
||||
"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
|
||||
|
||||
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
|
||||
split: object_ptr.splits sum.splits)
|
||||
|
||||
lemma is_node_ptr_kind_obtains:
|
||||
assumes "is_node_ptr_kind ptr"
|
||||
obtains node_ptr 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 ptr = Some node_ptr"
|
||||
using assms is_node_ptr_kind_def by auto
|
||||
|
||||
lemma is_node_ptr_kind_none:
|
||||
assumes "\<not>is_node_ptr_kind ptr"
|
||||
shows "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 = None"
|
||||
using assms
|
||||
unfolding is_node_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>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
|
||||
by auto
|
||||
|
||||
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]:
|
||||
"cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \<longleftrightarrow> 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]:
|
||||
"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]:
|
||||
"cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr \<in> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>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 \<longleftrightarrow> node_ptr \<in> node_ptrs"
|
||||
by auto
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/NodePointer.thy
|
|
@ -1,51 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Object\<close>
|
||||
text\<open>In this theory, we introduce the typed pointer for the class Object. This class is the
|
||||
common superclass of our class model.\<close>
|
||||
theory ObjectPointer
|
||||
imports
|
||||
Ref
|
||||
begin
|
||||
|
||||
datatype 'object_ptr object_ptr = Ext 'object_ptr
|
||||
register_default_tvars "'object_ptr object_ptr"
|
||||
|
||||
instantiation object_ptr :: (linorder) linorder
|
||||
begin
|
||||
definition less_eq_object_ptr :: "'object_ptr::linorder object_ptr \<Rightarrow> 'object_ptr object_ptr \<Rightarrow> bool"
|
||||
where "less_eq_object_ptr x y \<equiv> (case x of Ext i \<Rightarrow> (case y of Ext j \<Rightarrow> i \<le> j))"
|
||||
definition less_object_ptr :: "'object_ptr::linorder object_ptr \<Rightarrow> 'object_ptr object_ptr \<Rightarrow> bool"
|
||||
where "less_object_ptr x y \<equiv> x \<le> y \<and> \<not> y \<le> x"
|
||||
instance by(standard, auto simp add: less_eq_object_ptr_def less_object_ptr_def
|
||||
split: object_ptr.splits)
|
||||
end
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/ObjectPointer.thy
|
|
@ -1,62 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>References\<close>
|
||||
text\<open>
|
||||
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.\<close>
|
||||
theory
|
||||
Ref
|
||||
imports
|
||||
"HOL-Library.Adhoc_Overloading"
|
||||
"../preliminaries/Hiding_Type_Variables"
|
||||
begin
|
||||
|
||||
instantiation sum :: (linorder, linorder) linorder
|
||||
begin
|
||||
definition less_eq_sum :: "'a + 'b \<Rightarrow> 'a + 'b \<Rightarrow> bool"
|
||||
where
|
||||
"less_eq_sum t t' = (case t of
|
||||
Inl l \<Rightarrow> (case t' of
|
||||
Inl l' \<Rightarrow> l \<le> l'
|
||||
| Inr r' \<Rightarrow> True)
|
||||
| Inr r \<Rightarrow> (case t' of
|
||||
Inl l' \<Rightarrow> False
|
||||
| Inr r' \<Rightarrow> r \<le> r'))"
|
||||
definition less_sum :: "'a + 'b \<Rightarrow> 'a + 'b \<Rightarrow> bool"
|
||||
where
|
||||
"less_sum t t' \<equiv> t \<le> t' \<and> \<not> t' \<le> t"
|
||||
instance by(standard) (auto simp add: less_eq_sum_def less_sum_def split: sum.splits)
|
||||
end
|
||||
|
||||
type_synonym ref = nat
|
||||
consts cast :: 'a
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/pointers/Ref.thy
|
|
@ -1,930 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>The Heap Error Monad\<close>
|
||||
text \<open>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.\<close>
|
||||
theory
|
||||
Heap_Error_Monad
|
||||
imports
|
||||
Hiding_Type_Variables
|
||||
"HOL-Library.Monad_Syntax"
|
||||
begin
|
||||
|
||||
subsection \<open>The Program Data Type\<close>
|
||||
|
||||
datatype ('heap, 'e, 'result) prog = Prog (the_prog: "'heap \<Rightarrow> 'e + 'result \<times> 'heap")
|
||||
register_default_tvars "('heap, 'e, 'result) prog" (print, parse)
|
||||
|
||||
subsection \<open>Basic Functions\<close>
|
||||
|
||||
definition
|
||||
bind :: "(_, 'result) prog \<Rightarrow> ('result \<Rightarrow> (_, 'result2) prog) \<Rightarrow> (_, 'result2) prog"
|
||||
where
|
||||
"bind f g = Prog (\<lambda>h. (case (the_prog f) h of Inr (x, h') \<Rightarrow> (the_prog (g x)) h'
|
||||
| Inl exception \<Rightarrow> Inl exception))"
|
||||
|
||||
adhoc_overloading Monad_Syntax.bind bind
|
||||
|
||||
definition
|
||||
execute :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> ('e + 'result \<times> 'heap)"
|
||||
("((_)/ \<turnstile> (_))" [51, 52] 55)
|
||||
where
|
||||
"execute h p = (the_prog p) h"
|
||||
|
||||
definition
|
||||
returns_result :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> 'result \<Rightarrow> bool"
|
||||
("((_)/ \<turnstile> (_)/ \<rightarrow>\<^sub>r (_))" [60, 35, 61] 65)
|
||||
where
|
||||
"returns_result h p r \<longleftrightarrow> (case h \<turnstile> p of Inr (r', _) \<Rightarrow> r = r' | Inl _ \<Rightarrow> False)"
|
||||
|
||||
fun select_result ("|(_)|\<^sub>r")
|
||||
where
|
||||
"select_result (Inr (r, _)) = r"
|
||||
| "select_result (Inl _) = undefined"
|
||||
|
||||
lemma returns_result_eq [elim]: "h \<turnstile> f \<rightarrow>\<^sub>r y \<Longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>r y' \<Longrightarrow> y = y'"
|
||||
by(auto simp add: returns_result_def split: sum.splits)
|
||||
|
||||
definition
|
||||
returns_heap :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
("((_)/ \<turnstile> (_)/ \<rightarrow>\<^sub>h (_))" [60, 35, 61] 65)
|
||||
where
|
||||
"returns_heap h p h' \<longleftrightarrow> (case h \<turnstile> p of Inr (_ , h'') \<Rightarrow> h' = h'' | Inl _ \<Rightarrow> False)"
|
||||
|
||||
fun select_heap ("|(_)|\<^sub>h")
|
||||
where
|
||||
"select_heap (Inr ( _, h)) = h"
|
||||
| "select_heap (Inl _) = undefined"
|
||||
|
||||
lemma returns_heap_eq [elim]: "h \<turnstile> f \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>h h'' \<Longrightarrow> h' = h''"
|
||||
by(auto simp add: returns_heap_def split: sum.splits)
|
||||
|
||||
definition
|
||||
returns_result_heap :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> 'result \<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
("((_)/ \<turnstile> (_)/ \<rightarrow>\<^sub>r (_) \<rightarrow>\<^sub>h (_))" [60, 35, 61, 62] 65)
|
||||
where
|
||||
"returns_result_heap h p r h' \<longleftrightarrow> h \<turnstile> p \<rightarrow>\<^sub>r r \<and> h \<turnstile> p \<rightarrow>\<^sub>h h'"
|
||||
|
||||
lemma return_result_heap_code [code]: "returns_result_heap h p r h' \<longleftrightarrow> (case h \<turnstile> p of Inr (r', h'') \<Rightarrow> r = r' \<and> h' = h'' | Inl _ \<Rightarrow> False)"
|
||||
by(auto simp add: returns_result_heap_def returns_result_def returns_heap_def split: sum.splits)
|
||||
|
||||
fun select_result_heap ("|(_)|\<^sub>r\<^sub>h")
|
||||
where
|
||||
"select_result_heap (Inr (r, h)) = (r, h)"
|
||||
| "select_result_heap (Inl _) = undefined"
|
||||
|
||||
definition
|
||||
returns_error :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> 'e \<Rightarrow> bool"
|
||||
("((_)/ \<turnstile> (_)/ \<rightarrow>\<^sub>e (_))" [60, 35, 61] 65)
|
||||
where
|
||||
"returns_error h p e = (case h \<turnstile> p of Inr _ \<Rightarrow> False | Inl e' \<Rightarrow> e = e')"
|
||||
|
||||
definition is_OK :: "'heap \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> bool" ("((_)/ \<turnstile> ok (_))" [75, 75])
|
||||
where
|
||||
"is_OK h p = (case h \<turnstile> p of Inr _ \<Rightarrow> True | Inl _ \<Rightarrow> False)"
|
||||
|
||||
lemma is_OK_returns_result_I [intro]: "h \<turnstile> f \<rightarrow>\<^sub>r y \<Longrightarrow> h \<turnstile> ok f"
|
||||
by(auto simp add: is_OK_def returns_result_def split: sum.splits)
|
||||
|
||||
lemma is_OK_returns_result_E [elim]:
|
||||
assumes "h \<turnstile> ok f"
|
||||
obtains x where "h \<turnstile> f \<rightarrow>\<^sub>r x"
|
||||
using assms by(auto simp add: is_OK_def returns_result_def split: sum.splits)
|
||||
|
||||
lemma is_OK_returns_heap_I [intro]: "h \<turnstile> f \<rightarrow>\<^sub>h h' \<Longrightarrow> h \<turnstile> ok f"
|
||||
by(auto simp add: is_OK_def returns_heap_def split: sum.splits)
|
||||
|
||||
lemma is_OK_returns_heap_E [elim]:
|
||||
assumes "h \<turnstile> ok f"
|
||||
obtains h' where "h \<turnstile> f \<rightarrow>\<^sub>h h'"
|
||||
using assms by(auto simp add: is_OK_def returns_heap_def split: sum.splits)
|
||||
|
||||
lemma select_result_I:
|
||||
assumes "h \<turnstile> ok f"
|
||||
and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> P x"
|
||||
shows "P |h \<turnstile> f|\<^sub>r"
|
||||
using assms
|
||||
by(auto simp add: is_OK_def returns_result_def split: sum.splits)
|
||||
|
||||
lemma select_result_I2 [simp]:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>r x"
|
||||
shows "|h \<turnstile> f|\<^sub>r = x"
|
||||
using assms
|
||||
by(auto simp add: is_OK_def returns_result_def split: sum.splits)
|
||||
|
||||
lemma returns_result_select_result [simp]:
|
||||
assumes "h \<turnstile> ok f"
|
||||
shows "h \<turnstile> f \<rightarrow>\<^sub>r |h \<turnstile> f|\<^sub>r"
|
||||
using assms
|
||||
by (simp add: select_result_I)
|
||||
|
||||
lemma select_result_E:
|
||||
assumes "P |h \<turnstile> f|\<^sub>r" and "h \<turnstile> ok f"
|
||||
obtains x where "h \<turnstile> f \<rightarrow>\<^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: "(\<And>x .h \<turnstile> f \<rightarrow>\<^sub>r x = h' \<turnstile> f \<rightarrow>\<^sub>r x) \<Longrightarrow> |h \<turnstile> f|\<^sub>r = |h' \<turnstile> f|\<^sub>r"
|
||||
by (metis (no_types, lifting) is_OK_def old.sum.simps(6) select_result.elims
|
||||
select_result_I select_result_I2)
|
||||
|
||||
definition error :: "'e \<Rightarrow> ('heap, 'e, 'result) prog"
|
||||
where
|
||||
"error exception = Prog (\<lambda>h. Inl exception)"
|
||||
|
||||
lemma error_bind [iff]: "(error e \<bind> g) = error e"
|
||||
unfolding error_def bind_def by auto
|
||||
|
||||
lemma error_returns_result [simp]: "\<not> (h \<turnstile> error e \<rightarrow>\<^sub>r y)"
|
||||
unfolding returns_result_def error_def execute_def by auto
|
||||
|
||||
lemma error_returns_heap [simp]: "\<not> (h \<turnstile> error e \<rightarrow>\<^sub>h h')"
|
||||
unfolding returns_heap_def error_def execute_def by auto
|
||||
|
||||
lemma error_returns_error [simp]: "h \<turnstile> error e \<rightarrow>\<^sub>e e"
|
||||
unfolding returns_error_def error_def execute_def by auto
|
||||
|
||||
definition return :: "'result \<Rightarrow> ('heap, 'e, 'result) prog"
|
||||
where
|
||||
"return result = Prog (\<lambda>h. Inr (result, h))"
|
||||
|
||||
lemma return_ok [simp]: "h \<turnstile> ok (return x)"
|
||||
by(simp add: return_def is_OK_def execute_def)
|
||||
|
||||
lemma return_bind [iff]: "(return x \<bind> g) = g x"
|
||||
unfolding return_def bind_def by auto
|
||||
|
||||
lemma return_id [simp]: "f \<bind> return = f"
|
||||
by (induct f) (auto simp add: return_def bind_def split: sum.splits prod.splits)
|
||||
|
||||
lemma return_returns_result [iff]: "(h \<turnstile> return x \<rightarrow>\<^sub>r y) = (x = y)"
|
||||
unfolding returns_result_def return_def execute_def by auto
|
||||
|
||||
lemma return_returns_heap [iff]: "(h \<turnstile> return x \<rightarrow>\<^sub>h h') = (h = h')"
|
||||
unfolding returns_heap_def return_def execute_def by auto
|
||||
|
||||
lemma return_returns_error [iff]: "\<not> h \<turnstile> return x \<rightarrow>\<^sub>e e"
|
||||
unfolding returns_error_def execute_def return_def by auto
|
||||
|
||||
definition noop :: "('heap, 'e, unit) prog"
|
||||
where
|
||||
"noop = return ()"
|
||||
|
||||
lemma noop_returns_heap [simp]: "h \<turnstile> noop \<rightarrow>\<^sub>h h' \<longleftrightarrow> h = h'"
|
||||
by(simp add: noop_def)
|
||||
|
||||
definition get_heap :: "('heap, 'e, 'heap) prog"
|
||||
where
|
||||
"get_heap = Prog (\<lambda>h. h \<turnstile> return h)"
|
||||
|
||||
lemma get_heap_ok [simp]: "h \<turnstile> ok (get_heap)"
|
||||
by (simp add: get_heap_def execute_def is_OK_def return_def)
|
||||
|
||||
lemma get_heap_returns_result [simp]: "(h \<turnstile> get_heap \<bind> (\<lambda>h'. f h') \<rightarrow>\<^sub>r x) = (h \<turnstile> f h \<rightarrow>\<^sub>r x)"
|
||||
by(simp add: get_heap_def returns_result_def bind_def return_def execute_def)
|
||||
|
||||
lemma get_heap_returns_heap [simp]: "(h \<turnstile> get_heap \<bind> (\<lambda>h'. f h') \<rightarrow>\<^sub>h h'') = (h \<turnstile> f h \<rightarrow>\<^sub>h h'')"
|
||||
by(simp add: get_heap_def returns_heap_def bind_def return_def execute_def)
|
||||
|
||||
lemma get_heap_is_OK [simp]: "(h \<turnstile> ok (get_heap \<bind> (\<lambda>h'. f h'))) = (h \<turnstile> ok (f h))"
|
||||
by(auto simp add: get_heap_def is_OK_def bind_def return_def execute_def)
|
||||
|
||||
lemma get_heap_E [elim]: "(h \<turnstile> get_heap \<rightarrow>\<^sub>r x) \<Longrightarrow> x = h"
|
||||
by(simp add: get_heap_def returns_result_def return_def execute_def)
|
||||
|
||||
definition return_heap :: "'heap \<Rightarrow> ('heap, 'e, unit) prog"
|
||||
where
|
||||
"return_heap h = Prog (\<lambda>_. h \<turnstile> return ())"
|
||||
|
||||
lemma return_heap_E [iff]: "(h \<turnstile> return_heap h' \<rightarrow>\<^sub>h h'') = (h'' = h')"
|
||||
by(simp add: return_heap_def returns_heap_def return_def execute_def)
|
||||
|
||||
lemma return_heap_returns_result [simp]: "h \<turnstile> return_heap h' \<rightarrow>\<^sub>r ()"
|
||||
by(simp add: return_heap_def execute_def returns_result_def return_def)
|
||||
|
||||
|
||||
subsection \<open>Pure Heaps\<close>
|
||||
|
||||
definition pure :: "('heap, 'e, 'result) prog \<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
where "pure f h \<longleftrightarrow> h \<turnstile> ok f \<longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>h h"
|
||||
|
||||
lemma return_pure [simp]: "pure (return x) h"
|
||||
by(simp add: pure_def return_def is_OK_def returns_heap_def execute_def)
|
||||
|
||||
lemma error_pure [simp]: "pure (error e) h"
|
||||
by(simp add: pure_def error_def is_OK_def returns_heap_def execute_def)
|
||||
|
||||
lemma noop_pure [simp]: "pure (noop) h"
|
||||
by (simp add: noop_def)
|
||||
|
||||
lemma get_pure [simp]: "pure get_heap h"
|
||||
by(simp add: pure_def get_heap_def is_OK_def returns_heap_def return_def execute_def)
|
||||
|
||||
lemma pure_returns_heap_eq:
|
||||
"h \<turnstile> f \<rightarrow>\<^sub>h h' \<Longrightarrow> pure f h \<Longrightarrow> h = h'"
|
||||
by (meson pure_def is_OK_returns_heap_I returns_heap_eq)
|
||||
|
||||
lemma pure_eq_iff:
|
||||
"(\<forall>h' x. h \<turnstile> f \<rightarrow>\<^sub>r x \<longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>h h' \<longrightarrow> h = h') \<longleftrightarrow> pure f h"
|
||||
by(auto simp add: pure_def)
|
||||
|
||||
subsection \<open>Bind\<close>
|
||||
|
||||
lemma bind_assoc [simp]:
|
||||
"((bind f g) \<bind> h) = (f \<bind> (\<lambda>x. (g x \<bind> h)))"
|
||||
by(auto simp add: bind_def split: sum.splits)
|
||||
|
||||
lemma bind_returns_result_E:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y"
|
||||
obtains x h' where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
using assms by(auto simp add: bind_def returns_result_def returns_heap_def execute_def
|
||||
split: sum.splits)
|
||||
|
||||
lemma bind_returns_result_E2:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y" and "pure f h"
|
||||
obtains x where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
using assms pure_returns_heap_eq bind_returns_result_E by metis
|
||||
|
||||
lemma bind_returns_result_E3:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y" and "h \<turnstile> f \<rightarrow>\<^sub>r x" and "pure f h"
|
||||
shows "h \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
using assms returns_result_eq bind_returns_result_E2 by metis
|
||||
|
||||
lemma bind_returns_result_E4:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y" and "h \<turnstile> f \<rightarrow>\<^sub>r x"
|
||||
obtains h' where "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
using assms returns_result_eq bind_returns_result_E by metis
|
||||
|
||||
lemma bind_returns_heap_E:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h''"
|
||||
obtains x h' where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>h h''"
|
||||
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]:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h'" and "pure f h"
|
||||
obtains x where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> g x \<rightarrow>\<^sub>h h'"
|
||||
using assms pure_returns_heap_eq by (fastforce elim: bind_returns_heap_E)
|
||||
|
||||
lemma bind_returns_heap_E3 [elim]:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h'" and "h \<turnstile> f \<rightarrow>\<^sub>r x" and "pure f h"
|
||||
shows "h \<turnstile> g x \<rightarrow>\<^sub>h h'"
|
||||
using assms pure_returns_heap_eq returns_result_eq by (fastforce elim: bind_returns_heap_E)
|
||||
|
||||
lemma bind_returns_heap_E4:
|
||||
assumes "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h''" and "h \<turnstile> f \<rightarrow>\<^sub>h h'"
|
||||
obtains x where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h' \<turnstile> g x \<rightarrow>\<^sub>h h''"
|
||||
using assms
|
||||
by (metis bind_returns_heap_E returns_heap_eq)
|
||||
|
||||
lemma bind_returns_error_I [intro]:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>e e"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>e e"
|
||||
using assms
|
||||
by(auto simp add: returns_error_def bind_def execute_def split: sum.splits)
|
||||
|
||||
lemma bind_returns_error_I3:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>e e"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>e e"
|
||||
using assms
|
||||
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]:
|
||||
assumes "pure f h" and "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> g x \<rightarrow>\<^sub>e e"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>e e"
|
||||
using assms
|
||||
by (meson bind_returns_error_I3 is_OK_returns_result_I pure_def)
|
||||
|
||||
lemma bind_is_OK_E [elim]:
|
||||
assumes "h \<turnstile> ok (f \<bind> g)"
|
||||
obtains x h' where "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> ok (g x)"
|
||||
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 \<turnstile> ok (f \<bind> g)" and "h \<turnstile> f \<rightarrow>\<^sub>r x"
|
||||
obtains h' where "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> ok (g x)"
|
||||
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 \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y"
|
||||
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]:
|
||||
assumes "pure f h" and "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y"
|
||||
using assms
|
||||
by (meson bind_returns_result_I pure_def is_OK_returns_result_I)
|
||||
|
||||
lemma bind_pure_returns_result_I2 [intro]:
|
||||
assumes "pure f h" and "h \<turnstile> ok f" and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h \<turnstile> g x \<rightarrow>\<^sub>r y"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y"
|
||||
using assms by auto
|
||||
|
||||
lemma bind_returns_heap_I [intro]:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> g x \<rightarrow>\<^sub>h h''"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h''"
|
||||
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]:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h' \<turnstile> g x \<rightarrow>\<^sub>h h''"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>h h''"
|
||||
using assms
|
||||
by (meson bind_returns_heap_I is_OK_returns_heap_I is_OK_returns_result_E)
|
||||
|
||||
lemma bind_is_OK_I [intro]:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'" and "h' \<turnstile> ok (g x)"
|
||||
shows "h \<turnstile> ok (f \<bind> g)"
|
||||
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 \<turnstile> ok f" and "\<And>x h'. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>h h' \<Longrightarrow> h' \<turnstile> ok (g x)"
|
||||
shows "h \<turnstile> ok (f \<bind> g)"
|
||||
using assms by blast
|
||||
|
||||
lemma bind_is_OK_pure_I [intro]:
|
||||
assumes "pure f h" and "h \<turnstile> ok f" and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h \<turnstile> ok (g x)"
|
||||
shows "h \<turnstile> ok (f \<bind> g)"
|
||||
using assms by blast
|
||||
|
||||
lemma bind_pure_I:
|
||||
assumes "pure f h" and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> pure (g x) h"
|
||||
shows "pure (f \<bind> g) h"
|
||||
using assms
|
||||
by (metis bind_returns_heap_E2 pure_def pure_returns_heap_eq is_OK_returns_heap_E)
|
||||
|
||||
lemma pure_pure:
|
||||
assumes "h \<turnstile> ok f" and "pure f h"
|
||||
shows "h \<turnstile> f \<rightarrow>\<^sub>h h"
|
||||
using assms returns_heap_eq
|
||||
unfolding pure_def
|
||||
by auto
|
||||
|
||||
lemma bind_returns_error_eq:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>e e"
|
||||
and "h \<turnstile> g \<rightarrow>\<^sub>e e"
|
||||
shows "h \<turnstile> f = h \<turnstile> g"
|
||||
using assms
|
||||
by(auto simp add: returns_error_def split: sum.splits)
|
||||
|
||||
subsection \<open>Map\<close>
|
||||
|
||||
fun map_M :: "('x \<Rightarrow> ('heap, 'e, 'result) prog) \<Rightarrow> 'x list \<Rightarrow> ('heap, 'e, 'result list) prog"
|
||||
where
|
||||
"map_M f [] = return []"
|
||||
| "map_M f (x#xs) = do {
|
||||
y \<leftarrow> f x;
|
||||
ys \<leftarrow> map_M f xs;
|
||||
return (y # ys)
|
||||
}"
|
||||
|
||||
lemma map_M_ok_I [intro]:
|
||||
"(\<And>x. x \<in> set xs \<Longrightarrow> h \<turnstile> ok (f x)) \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> pure (f x) h) \<Longrightarrow> h \<turnstile> ok (map_M f xs)"
|
||||
apply(induct xs)
|
||||
by (simp_all add: bind_is_OK_I2 bind_is_OK_pure_I)
|
||||
|
||||
lemma map_M_pure_I : "\<And>h. (\<And>x. x \<in> set xs \<Longrightarrow> pure (f x) h) \<Longrightarrow> pure (map_M f xs) h"
|
||||
apply(induct xs)
|
||||
apply(simp)
|
||||
by(auto intro!: bind_pure_I)
|
||||
|
||||
lemma map_M_pure_E :
|
||||
assumes "h \<turnstile> map_M g xs \<rightarrow>\<^sub>r ys" and "x \<in> set xs" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (g x) h"
|
||||
obtains y where "h \<turnstile> g x \<rightarrow>\<^sub>r y" and "y \<in> set ys"
|
||||
apply(insert assms, induct xs arbitrary: ys)
|
||||
apply(simp)
|
||||
apply(auto elim!: bind_returns_result_E)[1]
|
||||
by (metis (full_types) pure_returns_heap_eq)
|
||||
|
||||
lemma map_M_pure_E2:
|
||||
assumes "h \<turnstile> map_M g xs \<rightarrow>\<^sub>r ys" and "y \<in> set ys" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (g x) h"
|
||||
obtains x where "h \<turnstile> g x \<rightarrow>\<^sub>r y" and "x \<in> set xs"
|
||||
apply(insert assms, induct xs arbitrary: ys)
|
||||
apply(simp)
|
||||
apply(auto elim!: bind_returns_result_E)[1]
|
||||
by (metis (full_types) pure_returns_heap_eq)
|
||||
|
||||
|
||||
subsection \<open>Forall\<close>
|
||||
|
||||
fun forall_M :: "('y \<Rightarrow> ('heap, 'e, 'result) prog) \<Rightarrow> 'y list \<Rightarrow> ('heap, 'e, unit) prog"
|
||||
where
|
||||
"forall_M P [] = return ()"
|
||||
| "forall_M P (x # xs) = do {
|
||||
P x;
|
||||
forall_M P xs
|
||||
}"
|
||||
(*
|
||||
lemma forall_M_elim:
|
||||
assumes "h \<turnstile> forall_M P xs \<rightarrow>\<^sub>r True" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (P x) h"
|
||||
shows "\<forall>x \<in> set xs. h \<turnstile> P x \<rightarrow>\<^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: "(\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h) \<Longrightarrow> pure (forall_M P xs) h"
|
||||
apply(induct xs)
|
||||
by(auto intro!: bind_pure_I)
|
||||
(*
|
||||
lemma forall_M_pure_I:
|
||||
assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<turnstile> P x \<rightarrow>\<^sub>r True" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (P x)h"
|
||||
shows "h \<turnstile> forall_M P xs \<rightarrow>\<^sub>r True"
|
||||
apply(insert assms, induct xs)
|
||||
apply(simp)
|
||||
by(fastforce)
|
||||
|
||||
lemma forall_M_pure_eq:
|
||||
assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<turnstile> P x \<rightarrow>\<^sub>r True \<longleftrightarrow> h' \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (P x) h"
|
||||
shows "(h \<turnstile> forall_M P xs \<rightarrow>\<^sub>r True) \<longleftrightarrow> h' \<turnstile> forall_M P xs \<rightarrow>\<^sub>r True"
|
||||
using assms
|
||||
by(auto intro!: forall_M_pure_I dest!: forall_M_elim) *)
|
||||
|
||||
subsection \<open>Fold\<close>
|
||||
|
||||
fun fold_M :: "('result \<Rightarrow> 'y \<Rightarrow> ('heap, 'e, 'result) prog) \<Rightarrow> 'result \<Rightarrow> 'y list
|
||||
\<Rightarrow> ('heap, 'e, 'result) prog"
|
||||
where
|
||||
"fold_M f d [] = return d" |
|
||||
"fold_M f d (x # xs) = do { y \<leftarrow> f d x; fold_M f y xs }"
|
||||
|
||||
lemma fold_M_pure_I : "(\<And>d x. pure (f d x) h) \<Longrightarrow> (\<And>d. pure (fold_M f d xs) h)"
|
||||
apply(induct xs)
|
||||
by(auto intro: bind_pure_I)
|
||||
|
||||
subsection \<open>Filter\<close>
|
||||
|
||||
fun filter_M :: "('x \<Rightarrow> ('heap, 'e, bool) prog) \<Rightarrow> 'x list \<Rightarrow> ('heap, 'e, 'x list) prog"
|
||||
where
|
||||
"filter_M P [] = return []"
|
||||
| "filter_M P (x#xs) = do {
|
||||
p \<leftarrow> P x;
|
||||
ys \<leftarrow> filter_M P xs;
|
||||
return (if p then x # ys else ys)
|
||||
}"
|
||||
|
||||
lemma filter_M_pure_I [intro]: "(\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h) \<Longrightarrow> pure (filter_M P xs)h"
|
||||
apply(induct xs)
|
||||
by(auto intro!: bind_pure_I)
|
||||
|
||||
lemma filter_M_is_OK_I [intro]: "(\<And>x. x \<in> set xs \<Longrightarrow> h \<turnstile> ok (P x)) \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h) \<Longrightarrow> h \<turnstile> ok (filter_M P xs)"
|
||||
apply(induct xs)
|
||||
apply(simp)
|
||||
by(auto intro!: bind_is_OK_pure_I)
|
||||
|
||||
lemma filter_M_not_more_elements:
|
||||
assumes "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys" and "\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h" and "x \<in> set ys"
|
||||
shows "x \<in> set xs"
|
||||
apply(insert assms, induct xs arbitrary: ys)
|
||||
by(auto elim!: bind_returns_result_E2 split: if_splits intro!: set_ConsD)
|
||||
|
||||
lemma filter_M_in_result_if_ok:
|
||||
assumes "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys" and "\<And>h x. x \<in> set xs \<Longrightarrow> pure (P x) h" and "x \<in> set xs" and "h \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
shows "x \<in> set ys"
|
||||
apply(insert assms, induct xs arbitrary: ys)
|
||||
apply(simp)
|
||||
apply(auto elim!: bind_returns_result_E2)[1]
|
||||
by (metis returns_result_eq)
|
||||
|
||||
lemma filter_M_holds_for_result:
|
||||
assumes "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys" and "x \<in> set ys" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (P x) h"
|
||||
shows "h \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
apply(insert assms, induct xs arbitrary: ys)
|
||||
by(auto elim!: bind_returns_result_E2 split: if_splits intro!: set_ConsD)
|
||||
|
||||
lemma filter_M_empty_I:
|
||||
assumes "\<And>x. pure (P x) h"
|
||||
and "\<forall>x \<in> set xs. h \<turnstile> P x \<rightarrow>\<^sub>r False"
|
||||
shows "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r []"
|
||||
using assms
|
||||
apply(induct xs)
|
||||
by(auto intro!: bind_pure_returns_result_I)
|
||||
|
||||
lemma filter_M_subset_2: "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys \<Longrightarrow> h' \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys'
|
||||
\<Longrightarrow> (\<And>x. pure (P x) h) \<Longrightarrow> (\<And>x. pure (P x) h')
|
||||
\<Longrightarrow> (\<forall>b. \<forall>x \<in> set xs. h \<turnstile> P x \<rightarrow>\<^sub>r True \<longrightarrow> h' \<turnstile> P x \<rightarrow>\<^sub>r b \<longrightarrow> b)
|
||||
\<Longrightarrow> set ys \<subseteq> set ys'"
|
||||
proof -
|
||||
assume 1: "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys" and 2: "h' \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys'"
|
||||
and 3: "(\<And>x. pure (P x) h)" and "(\<And>x. pure (P x) h')"
|
||||
and 4: "\<forall>b. \<forall>x\<in>set xs. h \<turnstile> P x \<rightarrow>\<^sub>r True \<longrightarrow> h' \<turnstile> P x \<rightarrow>\<^sub>r b \<longrightarrow> b"
|
||||
have h1: "\<forall>x \<in> set xs. h' \<turnstile> ok (P x)"
|
||||
using 2 3 \<open>(\<And>x. pure (P x) h')\<close>
|
||||
apply(induct xs arbitrary: ys')
|
||||
by(auto elim!: bind_returns_result_E2)
|
||||
then have 5: "\<forall>x\<in>set xs. h \<turnstile> P x \<rightarrow>\<^sub>r True \<longrightarrow> h' \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
using 4
|
||||
apply(auto)[1]
|
||||
by (metis is_OK_returns_result_E)
|
||||
show ?thesis
|
||||
using 1 2 3 5 \<open>(\<And>x. pure (P x) h')\<close>
|
||||
apply(induct xs arbitrary: ys ys')
|
||||
apply(auto)[1]
|
||||
apply(auto elim!: bind_returns_result_E2 split: if_splits)[1]
|
||||
apply auto[1]
|
||||
apply auto[1]
|
||||
apply(metis returns_result_eq)
|
||||
apply auto[1]
|
||||
apply auto[1]
|
||||
apply auto[1]
|
||||
by(auto)
|
||||
qed
|
||||
|
||||
lemma filter_M_subset: "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys \<Longrightarrow> set ys \<subseteq> set xs"
|
||||
apply(induct xs arbitrary: h ys)
|
||||
apply(auto)[1]
|
||||
apply(auto elim!: bind_returns_result_E split: if_splits)[1]
|
||||
apply blast
|
||||
by blast
|
||||
|
||||
lemma filter_M_distinct: "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys \<Longrightarrow> distinct xs \<Longrightarrow> distinct ys"
|
||||
apply(induct xs arbitrary: h ys)
|
||||
apply(auto)[1]
|
||||
using filter_M_subset
|
||||
apply(auto elim!: bind_returns_result_E)[1]
|
||||
by fastforce
|
||||
|
||||
lemma filter_M_filter: "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h)
|
||||
\<Longrightarrow> (\<forall>x \<in> set xs. h \<turnstile> ok P x) \<and> ys = filter (\<lambda>x. |h \<turnstile> P x|\<^sub>r) xs"
|
||||
apply(induct xs arbitrary: ys)
|
||||
by(auto elim!: bind_returns_result_E2)
|
||||
|
||||
lemma filter_M_filter2: "(\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h \<and> h \<turnstile> ok P x)
|
||||
\<Longrightarrow> filter (\<lambda>x. |h \<turnstile> P x|\<^sub>r) xs = ys \<Longrightarrow> h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys"
|
||||
apply(induct xs arbitrary: ys)
|
||||
by(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)
|
||||
|
||||
lemma filter_ex1: "\<exists>!x \<in> set xs. P x \<Longrightarrow> P x \<Longrightarrow> x \<in> set xs \<Longrightarrow> distinct xs
|
||||
\<Longrightarrow> filter P xs = [x]"
|
||||
apply(auto)[1]
|
||||
apply(induct xs)
|
||||
apply(auto)[1]
|
||||
apply(auto)[1]
|
||||
using filter_empty_conv by fastforce
|
||||
|
||||
lemma filter_M_ex1:
|
||||
assumes "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys"
|
||||
and "x \<in> set xs"
|
||||
and "\<exists>!x \<in> set xs. h \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
and "\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h"
|
||||
and "distinct xs"
|
||||
and "h \<turnstile> P x \<rightarrow>\<^sub>r True"
|
||||
shows "ys = [x]"
|
||||
proof -
|
||||
have *: "\<exists>!x \<in> set xs. |h \<turnstile> P x|\<^sub>r"
|
||||
apply(insert assms(1) assms(3) assms(4))
|
||||
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
|
||||
list.set_intros(1) list.set_intros(2) member_filter select_result_I2)
|
||||
qed
|
||||
|
||||
lemma filter_M_eq:
|
||||
assumes "\<And>x. pure (P x) h" and "\<And>x. pure (P x) h'"
|
||||
and "\<And>b x. x \<in> set xs \<Longrightarrow> h \<turnstile> P x \<rightarrow>\<^sub>r b = h' \<turnstile> P x \<rightarrow>\<^sub>r b"
|
||||
shows "h \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys \<longleftrightarrow> h' \<turnstile> filter_M P xs \<rightarrow>\<^sub>r ys"
|
||||
using assms
|
||||
apply (induct xs arbitrary: ys)
|
||||
by(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I
|
||||
dest: returns_result_eq)
|
||||
|
||||
|
||||
subsection \<open>Map Filter\<close>
|
||||
|
||||
definition map_filter_M :: "('x \<Rightarrow> ('heap, 'e, 'y option) prog) \<Rightarrow> 'x list
|
||||
\<Rightarrow> ('heap, 'e, 'y list) prog"
|
||||
where
|
||||
"map_filter_M f xs = do {
|
||||
ys_opts \<leftarrow> map_M f xs;
|
||||
ys_no_opts \<leftarrow> filter_M (\<lambda>x. return (x \<noteq> None)) ys_opts;
|
||||
map_M (\<lambda>x. return (the x)) ys_no_opts
|
||||
}"
|
||||
|
||||
lemma map_filter_M_pure: "(\<And>x h. x \<in> set xs \<Longrightarrow> pure (f x) h) \<Longrightarrow> pure (map_filter_M f xs) h"
|
||||
by(auto simp add: map_filter_M_def map_M_pure_I intro!: bind_pure_I)
|
||||
|
||||
lemma map_filter_M_pure_E:
|
||||
assumes "h \<turnstile> (map_filter_M::('x \<Rightarrow> ('heap, 'e, 'y option) prog) \<Rightarrow> 'x list
|
||||
\<Rightarrow> ('heap, 'e, 'y list) prog) f xs \<rightarrow>\<^sub>r ys" and "y \<in> set ys" and "\<And>x h. x \<in> set xs \<Longrightarrow> pure (f x) h"
|
||||
obtains x where "h \<turnstile> f x \<rightarrow>\<^sub>r Some y" and "x \<in> set xs"
|
||||
proof -
|
||||
obtain ys_opts ys_no_opts where
|
||||
ys_opts: "h \<turnstile> map_M f xs \<rightarrow>\<^sub>r ys_opts" and
|
||||
ys_no_opts: "h \<turnstile> filter_M (\<lambda>x. (return (x \<noteq> None)::('heap, 'e, bool) prog)) ys_opts \<rightarrow>\<^sub>r ys_no_opts" and
|
||||
ys: "h \<turnstile> map_M (\<lambda>x. (return (the x)::('heap, 'e, 'y) prog)) ys_no_opts \<rightarrow>\<^sub>r ys"
|
||||
using assms
|
||||
by(auto simp add: map_filter_M_def map_M_pure_I elim!: bind_returns_result_E2)
|
||||
have "\<forall>y \<in> set ys_no_opts. y \<noteq> None"
|
||||
using ys_no_opts filter_M_holds_for_result
|
||||
by fastforce
|
||||
then have "Some y \<in> set ys_no_opts"
|
||||
using map_M_pure_E2 ys \<open>y \<in> set ys\<close>
|
||||
by (metis (no_types, lifting) option.collapse return_pure return_returns_result)
|
||||
then have "Some y \<in> set ys_opts"
|
||||
using filter_M_subset ys_no_opts by fastforce
|
||||
then show "(\<And>x. h \<turnstile> f x \<rightarrow>\<^sub>r Some y \<Longrightarrow> x \<in> set xs \<Longrightarrow> thesis) \<Longrightarrow> thesis"
|
||||
by (metis assms(3) map_M_pure_E2 ys_opts)
|
||||
qed
|
||||
|
||||
|
||||
subsection \<open>Iterate\<close>
|
||||
|
||||
fun iterate_M :: "('heap, 'e, 'result) prog list \<Rightarrow> ('heap, 'e, 'result) prog"
|
||||
where
|
||||
"iterate_M [] = return undefined"
|
||||
| "iterate_M (x # xs) = x \<bind> (\<lambda>_. iterate_M xs)"
|
||||
|
||||
|
||||
lemma iterate_M_concat:
|
||||
assumes "h \<turnstile> iterate_M xs \<rightarrow>\<^sub>h h'"
|
||||
and "h' \<turnstile> iterate_M ys \<rightarrow>\<^sub>h h''"
|
||||
shows "h \<turnstile> iterate_M (xs @ ys) \<rightarrow>\<^sub>h h''"
|
||||
using assms
|
||||
apply(induct "xs" arbitrary: h h'')
|
||||
apply(simp)
|
||||
apply(auto)[1]
|
||||
by (meson bind_returns_heap_E bind_returns_heap_I)
|
||||
|
||||
subsection\<open>Miscellaneous Rules\<close>
|
||||
|
||||
lemma execute_bind_simp:
|
||||
assumes "h \<turnstile> f \<rightarrow>\<^sub>r x" and "h \<turnstile> f \<rightarrow>\<^sub>h h'"
|
||||
shows "h \<turnstile> f \<bind> g = h' \<turnstile> g x"
|
||||
using assms
|
||||
by(auto simp add: returns_result_def returns_heap_def bind_def execute_def
|
||||
split: sum.splits)
|
||||
|
||||
lemma bind_cong [fundef_cong]:
|
||||
fixes f1 f2 :: "('heap, 'e, 'result) prog"
|
||||
and g1 g2 :: "'result \<Rightarrow> ('heap, 'e, 'result2) prog"
|
||||
assumes "h \<turnstile> f1 = h \<turnstile> f2"
|
||||
and "\<And>y h'. h \<turnstile> f1 \<rightarrow>\<^sub>r y \<Longrightarrow> h \<turnstile> f1 \<rightarrow>\<^sub>h h' \<Longrightarrow> h' \<turnstile> g1 y = h' \<turnstile> g2 y"
|
||||
shows "h \<turnstile> (f1 \<bind> g1) = h \<turnstile> (f2 \<bind> g2)"
|
||||
apply(insert assms, cases "h \<turnstile> f1")
|
||||
by(auto simp add: bind_def returns_result_def returns_heap_def execute_def
|
||||
split: sum.splits)
|
||||
|
||||
lemma bind_cong_2:
|
||||
assumes "pure f h" and "pure f h'"
|
||||
and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x = h' \<turnstile> f \<rightarrow>\<^sub>r x"
|
||||
and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h \<turnstile> g x \<rightarrow>\<^sub>r y = h' \<turnstile> g x \<rightarrow>\<^sub>r y'"
|
||||
shows "h \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y = h' \<turnstile> f \<bind> g \<rightarrow>\<^sub>r y'"
|
||||
using assms
|
||||
by(auto intro!: bind_pure_returns_result_I elim!: bind_returns_result_E2)
|
||||
|
||||
lemma bind_case_cong [fundef_cong]:
|
||||
assumes "x = x'" and "\<And>a. x = Some a \<Longrightarrow> f a h = f' a h"
|
||||
shows "(case x of Some a \<Rightarrow> f a | None \<Rightarrow> g) h = (case x' of Some a \<Rightarrow> f' a | None \<Rightarrow> g) h"
|
||||
by (insert assms, simp add: option.case_eq_if)
|
||||
|
||||
|
||||
subsection \<open>Reasoning About Reads and Writes\<close>
|
||||
|
||||
definition preserved :: "('heap, 'e, 'result) prog \<Rightarrow> 'heap \<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
where
|
||||
"preserved f h h' \<longleftrightarrow> (\<forall>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<longleftrightarrow> h' \<turnstile> f \<rightarrow>\<^sub>r x)"
|
||||
|
||||
lemma preserved_code [code]: "preserved f h h' = (((h \<turnstile> ok f) \<and> (h' \<turnstile> ok f) \<and> |h \<turnstile> f|\<^sub>r = |h' \<turnstile> f|\<^sub>r) \<or> ((\<not>h \<turnstile> ok f) \<and> (\<not>h' \<turnstile> ok f)))"
|
||||
apply(auto simp add: preserved_def)[1]
|
||||
apply (meson is_OK_returns_result_E is_OK_returns_result_I)+
|
||||
done
|
||||
|
||||
lemma reflp_preserved_f [simp]: "reflp (preserved f)"
|
||||
by(auto simp add: preserved_def reflp_def)
|
||||
lemma transp_preserved_f [simp]: "transp (preserved f)"
|
||||
by(auto simp add: preserved_def transp_def)
|
||||
|
||||
|
||||
definition
|
||||
all_args :: "('a \<Rightarrow> ('heap, 'e, 'result) prog) \<Rightarrow> ('heap, 'e, 'result) prog set"
|
||||
where
|
||||
"all_args f = (\<Union>arg. {f arg})"
|
||||
|
||||
|
||||
definition
|
||||
reads :: "('heap \<Rightarrow> 'heap \<Rightarrow> bool) set \<Rightarrow> ('heap, 'e, 'result) prog \<Rightarrow> 'heap
|
||||
\<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
where
|
||||
"reads S getter h h' \<longleftrightarrow> (\<forall>P \<in> S. reflp P \<and> transp P) \<and> ((\<forall>P \<in> S. P h h')
|
||||
\<longrightarrow> preserved getter h h')"
|
||||
|
||||
lemma reads_singleton [simp]: "reads {preserved f} f h h'"
|
||||
by(auto simp add: reads_def)
|
||||
|
||||
lemma reads_bind_pure:
|
||||
assumes "pure f h" and "pure f h'"
|
||||
and "reads S f h h'"
|
||||
and "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> reads S (g x) h h'"
|
||||
shows "reads S (f \<bind> 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
|
||||
elim!: bind_returns_result_E)
|
||||
|
||||
lemma reads_insert_writes_set_left: "\<forall>P \<in> S. reflp P \<and> transp P \<Longrightarrow> reads {getter} f h h' \<Longrightarrow> reads (insert getter S) f h h'"
|
||||
unfolding reads_def by simp
|
||||
|
||||
lemma reads_insert_writes_set_right: "reflp getter \<Longrightarrow> transp getter \<Longrightarrow> reads S f h h' \<Longrightarrow> reads (insert getter S) f h h'"
|
||||
unfolding reads_def by blast
|
||||
|
||||
lemma reads_subset: "reads S f h h' \<Longrightarrow> \<forall>P \<in> S' - S. reflp P \<and> transp P \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> reads S' f h h'"
|
||||
by(auto simp add: reads_def)
|
||||
|
||||
lemma return_reads [simp]: "reads {} (return x) h h'"
|
||||
by(simp add: reads_def preserved_def)
|
||||
|
||||
lemma error_reads [simp]: "reads {} (error e) h h'"
|
||||
by(simp add: reads_def preserved_def)
|
||||
|
||||
lemma noop_reads [simp]: "reads {} noop h h'"
|
||||
by(simp add: reads_def noop_def preserved_def)
|
||||
|
||||
lemma filter_M_reads:
|
||||
assumes "\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h" and "\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h'"
|
||||
and "\<And>x. x \<in> set xs \<Longrightarrow> reads S (P x) h h'"
|
||||
and "\<forall>P \<in> S. reflp P \<and> transp P"
|
||||
shows "reads S (filter_M P xs) h h'"
|
||||
using assms
|
||||
apply(induct xs)
|
||||
by(auto intro: reads_subset[OF return_reads] intro!: reads_bind_pure)
|
||||
|
||||
definition writes ::
|
||||
"('heap, 'e, 'result) prog set \<Rightarrow> ('heap, 'e, 'result2) prog \<Rightarrow> 'heap \<Rightarrow> 'heap \<Rightarrow> bool"
|
||||
where
|
||||
"writes S setter h h'
|
||||
\<longleftrightarrow> (h \<turnstile> setter \<rightarrow>\<^sub>h h' \<longrightarrow> (\<exists>progs. set progs \<subseteq> S \<and> h \<turnstile> iterate_M progs \<rightarrow>\<^sub>h h'))"
|
||||
|
||||
lemma writes_singleton [simp]: "writes (all_args f) (f a) h h'"
|
||||
apply(auto simp add: writes_def all_args_def)[1]
|
||||
apply(rule exI[where x="[f a]"])
|
||||
by(auto)
|
||||
|
||||
lemma writes_singleton2 [simp]: "writes {f} f h h'"
|
||||
apply(auto simp add: writes_def all_args_def)[1]
|
||||
apply(rule exI[where x="[f]"])
|
||||
by(auto)
|
||||
|
||||
lemma writes_union_left_I:
|
||||
assumes "writes S f h h'"
|
||||
shows "writes (S \<union> S') f h h'"
|
||||
using assms
|
||||
by(auto simp add: writes_def)
|
||||
|
||||
lemma writes_union_right_I:
|
||||
assumes "writes S' f h h'"
|
||||
shows "writes (S \<union> S') f h h'"
|
||||
using assms
|
||||
by(auto simp add: writes_def)
|
||||
|
||||
lemma writes_union_minus_split:
|
||||
assumes "writes (S - S2) f h h'"
|
||||
and "writes (S' - S2) f h h'"
|
||||
shows "writes ((S \<union> S') - S2) f h h'"
|
||||
using assms
|
||||
by(auto simp add: writes_def)
|
||||
|
||||
lemma writes_subset: "writes S f h h' \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> writes S' f h h'"
|
||||
by(auto simp add: writes_def)
|
||||
|
||||
lemma writes_error [simp]: "writes S (error e) h h'"
|
||||
by(simp add: writes_def)
|
||||
|
||||
lemma writes_not_ok [simp]: "\<not>h \<turnstile> ok f \<Longrightarrow> writes S f h h'"
|
||||
by(auto simp add: writes_def)
|
||||
|
||||
lemma writes_pure [simp]:
|
||||
assumes "pure f h"
|
||||
shows "writes S f h h'"
|
||||
using assms
|
||||
apply(auto simp add: writes_def)[1]
|
||||
by (metis bot.extremum iterate_M.simps(1) list.set(1) pure_returns_heap_eq return_returns_heap)
|
||||
|
||||
lemma writes_bind:
|
||||
assumes "\<And>h2. writes S f h h2"
|
||||
assumes "\<And>x h2. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> h \<turnstile> f \<rightarrow>\<^sub>h h2 \<Longrightarrow> writes S (g x) h2 h'"
|
||||
shows "writes S (f \<bind> g) h h'"
|
||||
using assms
|
||||
apply(auto simp add: writes_def elim!: bind_returns_heap_E)[1]
|
||||
by (metis iterate_M_concat le_supI set_append)
|
||||
|
||||
lemma writes_bind_pure:
|
||||
assumes "pure f h"
|
||||
assumes "\<And>x. h \<turnstile> f \<rightarrow>\<^sub>r x \<Longrightarrow> writes S (g x) h h'"
|
||||
shows "writes S (f \<bind> g) h h'"
|
||||
using assms
|
||||
by(auto simp add: writes_def elim!: bind_returns_heap_E2)
|
||||
|
||||
lemma writes_small_big:
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h' w. w \<in> SW \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> P h h'"
|
||||
assumes "reflp P"
|
||||
assumes "transp P"
|
||||
shows "P h h'"
|
||||
proof -
|
||||
obtain progs where "set progs \<subseteq> SW" and iterate: "h \<turnstile> iterate_M progs \<rightarrow>\<^sub>h h'"
|
||||
by (meson assms(1) assms(2) writes_def)
|
||||
then have "\<And>h h'. \<forall>prog \<in> set progs. h \<turnstile> prog \<rightarrow>\<^sub>h h' \<longrightarrow> P h h'"
|
||||
using assms(3) by auto
|
||||
with iterate assms(4) assms(5) have "h \<turnstile> iterate_M progs \<rightarrow>\<^sub>h h' \<Longrightarrow> P h h'"
|
||||
proof(induct progs arbitrary: h)
|
||||
case Nil
|
||||
then show ?case
|
||||
using reflpE by force
|
||||
next
|
||||
case (Cons a progs)
|
||||
then show ?case
|
||||
apply(auto elim!: bind_returns_heap_E)[1]
|
||||
by (metis (full_types) transpD)
|
||||
qed
|
||||
then show ?thesis
|
||||
using assms(1) iterate by blast
|
||||
qed
|
||||
|
||||
lemma reads_writes_preserved:
|
||||
assumes "reads SR getter h h'"
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> SR. r h h')"
|
||||
shows "h \<turnstile> getter \<rightarrow>\<^sub>r x \<longleftrightarrow> h' \<turnstile> getter \<rightarrow>\<^sub>r x"
|
||||
proof -
|
||||
obtain progs where "set progs \<subseteq> SW" and iterate: "h \<turnstile> iterate_M progs \<rightarrow>\<^sub>h h'"
|
||||
by (meson assms(2) assms(3) writes_def)
|
||||
then have "\<And>h h'. \<forall>prog \<in> set progs. h \<turnstile> prog \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> SR. r h h')"
|
||||
using assms(4) by blast
|
||||
with iterate have "\<forall>r \<in> SR. r h h'"
|
||||
using writes_small_big assms(1) unfolding reads_def
|
||||
by (metis assms(2) assms(3) assms(4))
|
||||
then show ?thesis
|
||||
using assms(1)
|
||||
by (simp add: preserved_def reads_def)
|
||||
qed
|
||||
|
||||
lemma reads_writes_separate_forwards:
|
||||
assumes "reads SR getter h h'"
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "h \<turnstile> getter \<rightarrow>\<^sub>r x"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> SR. r h h')"
|
||||
shows "h' \<turnstile> getter \<rightarrow>\<^sub>r x"
|
||||
using reads_writes_preserved[OF assms(1) assms(2) assms(3) assms(5)] assms(4)
|
||||
by(auto simp add: preserved_def)
|
||||
|
||||
lemma reads_writes_separate_backwards:
|
||||
assumes "reads SR getter h h'"
|
||||
assumes "writes SW setter h h'"
|
||||
assumes "h \<turnstile> setter \<rightarrow>\<^sub>h h'"
|
||||
assumes "h' \<turnstile> getter \<rightarrow>\<^sub>r x"
|
||||
assumes "\<And>h h'. \<forall>w \<in> SW. h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> SR. r h h')"
|
||||
shows "h \<turnstile> getter \<rightarrow>\<^sub>r x"
|
||||
using reads_writes_preserved[OF assms(1) assms(2) assms(3) assms(5)] assms(4)
|
||||
by(auto simp add: preserved_def)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/preliminaries/Heap_Error_Monad.thy
|
|
@ -1,584 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2018 Achim D. Brucker
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
* Repository: https://git.logicalhacking.com/adbrucker/isabelle-hacks/
|
||||
* 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
|
||||
checks).
|
||||
*)
|
||||
|
||||
section\<open>Hiding Type Variables\<close>
|
||||
text\<open> 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
|
||||
data types with many type variables.\<close>
|
||||
theory
|
||||
"Hiding_Type_Variables"
|
||||
imports
|
||||
Main
|
||||
keywords
|
||||
"register_default_tvars"
|
||||
"update_default_tvars_mode"::thy_decl
|
||||
begin
|
||||
(*<*)
|
||||
section\<open>Implementation\<close>
|
||||
subsection\<open>Theory Managed Data Structure\<close>
|
||||
ML\<open>
|
||||
signature HIDE_TVAR = sig
|
||||
datatype print_mode = print_all | print | noprint
|
||||
datatype tvar_subst = right | left
|
||||
datatype parse_mode = parse | noparse
|
||||
type hide_varT = {
|
||||
name: string,
|
||||
tvars: typ list,
|
||||
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 ->
|
||||
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_ast_tr : Proof.context -> Ast.ast list -> Ast.ast
|
||||
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
|
||||
-> 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
|
||||
type hide_varT = {
|
||||
name: string,
|
||||
tvars: typ list,
|
||||
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')
|
||||
|
||||
structure Data = Generic_Data
|
||||
(
|
||||
type T = hide_tvar_tab
|
||||
val empty = Symtab.empty:hide_tvar_tab
|
||||
val extend = I
|
||||
fun merge(t1,t2) = merge_tvar_tab (t1, t2)
|
||||
);
|
||||
|
||||
|
||||
fun parse_print_mode "print_all" = print_all
|
||||
| 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
|
||||
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
|
||||
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
|
||||
| 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
|
||||
SOME m => m
|
||||
| NONE => #parse_mode old_entry
|
||||
val entry = {
|
||||
name = name,
|
||||
tvars = #tvars old_entry,
|
||||
typ_syn_tab = #typ_syn_tab old_entry,
|
||||
print_mode = print_m,
|
||||
parse_mode = parse_m
|
||||
}
|
||||
in
|
||||
Symtab.update (name,entry) tab
|
||||
end
|
||||
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
|
||||
Symtab.lookup tab name
|
||||
end
|
||||
|
||||
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
|
||||
| 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
|
||||
fun switch (a,b) = (b,a)
|
||||
val (Ts', lt') = fold_map (fn t => fn lt => switch (normalize_typvar_type lt t)) Ts lt
|
||||
in
|
||||
(lt', Type (a, Ts'))
|
||||
end
|
||||
| normalize_typvar_type lt (TFree (vname, S)) =
|
||||
let
|
||||
val (lt, vname) = obtain_normalized_vname lt (vname)
|
||||
in
|
||||
(lt, TFree( vname, S))
|
||||
end
|
||||
| normalize_typvar_type lt (TVar (xi, S)) =
|
||||
let
|
||||
val (lt, vname) = obtain_normalized_vname lt (Term.string_of_vname xi)
|
||||
in
|
||||
(lt, TFree( vname, S))
|
||||
end
|
||||
|
||||
fun normalize_typvar_type' t = snd ( normalize_typvar_type [] t)
|
||||
|
||||
fun mk_p s = s (* "("^s^")" *)
|
||||
|
||||
fun key_of_type (Type(a, TS)) = mk_p (a^String.concat(map key_of_type TS))
|
||||
| key_of_type (TFree (vname, _)) = mk_p vname
|
||||
| key_of_type (TVar (xi, _ )) = mk_p (Term.string_of_vname xi)
|
||||
val key_of_type' = key_of_type o normalize_typvar_type'
|
||||
|
||||
|
||||
fun normalize_typvar_term lt (Const (a, t)) = (lt, Const(a, t))
|
||||
| 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
|
||||
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
|
||||
val (lt,tr) = normalize_typvar_term lt tr
|
||||
in
|
||||
(lt, Abs(s,ty,tr))
|
||||
end
|
||||
| normalize_typvar_term lt (t1$t2) =
|
||||
let
|
||||
val (lt,t1) = normalize_typvar_term lt t1
|
||||
val (lt,t2) = normalize_typvar_term lt t2
|
||||
in
|
||||
(lt, t1$t2)
|
||||
end
|
||||
|
||||
|
||||
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 (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 (fq_name, _) = case mtyp of
|
||||
Type(s,ts) => (s,ts)
|
||||
| _ => 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)
|
||||
|
||||
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
|
||||
NONE => raise Match
|
||||
| SOME e => let
|
||||
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
|
||||
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
|
||||
|
||||
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.")
|
||||
|
||||
val (decorated_name, decorated_sort) = parse_ast ast
|
||||
|
||||
val name = Lexicon.unmark_type decorated_name
|
||||
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
|
||||
then error("Default type vars disabled (option noparse): "^name)
|
||||
else ()
|
||||
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
|
||||
NONE => Ast.Variable(name_of_tvar n)
|
||||
| SOME sort => Ast.Appl([Ast.Constant("_ofsort"),
|
||||
Ast.Variable(name_of_tvar n),
|
||||
Ast.Constant(sort)])
|
||||
in
|
||||
map mk_tvar (#tvars default_info)
|
||||
end
|
||||
in
|
||||
Ast.Appl ((Ast.Constant decorated_name)::type_vars_ast)
|
||||
end
|
||||
|
||||
fun register typ_str print_mode parse_mode thy =
|
||||
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.")
|
||||
|
||||
val base_key = key_of_type' base_typ
|
||||
val base_tvar_key = key_of_type base_typ
|
||||
|
||||
val print_m = case print_mode of
|
||||
SOME m => m
|
||||
| NONE => print_all
|
||||
val parse_m = case parse_mode of
|
||||
SOME m => m
|
||||
| NONE => parse
|
||||
val entry = {
|
||||
name = name,
|
||||
tvars = tvars,
|
||||
typ_syn_tab = Symtab.empty:((string * typ list * string) Symtab.table),
|
||||
print_mode = print_m,
|
||||
parse_mode = parse_m
|
||||
}
|
||||
|
||||
val base_entry = if name = base_name
|
||||
then
|
||||
{
|
||||
name = "",
|
||||
tvars = [],
|
||||
typ_syn_tab = Symtab.empty:((string * typ list * string) Symtab.table),
|
||||
print_mode = noprint,
|
||||
parse_mode = noparse
|
||||
}
|
||||
else case lookup thy base_name of
|
||||
SOME e => e
|
||||
| NONE => error ("No entry found for "^base_name^
|
||||
" (via "^name^")")
|
||||
|
||||
val base_entry = {
|
||||
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)),
|
||||
print_mode = #print_mode base_entry,
|
||||
parse_mode = #parse_mode base_entry
|
||||
}
|
||||
|
||||
fun reg tab = let
|
||||
val tab = Symtab.update_new(name, entry) tab
|
||||
val tab = if name = base_name
|
||||
then tab
|
||||
else Symtab.update(base_name, base_entry) tab
|
||||
in
|
||||
tab
|
||||
end
|
||||
|
||||
val thy = Sign.print_translation
|
||||
[(Lexicon.mark_type name, hide_tvar_tr' name)] thy
|
||||
|
||||
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
|
||||
|
||||
val thy = Proof_Context.theory_of ctx
|
||||
val (decorated_name, args) = case ast
|
||||
of (Ast.Appl ((Ast.Constant s)::args)) => (s, args)
|
||||
| _ => error "Error in obtaining type constructor."
|
||||
|
||||
val name = Lexicon.unmark_type decorated_name
|
||||
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
|
||||
then error("Default type vars disabled (option noparse): "^name)
|
||||
else ()
|
||||
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
|
||||
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
|
||||
| hide_tvar_subst_ast_tr _ _ _ = error("hide_tvar_subst_ast_tr: empty AST.")
|
||||
|
||||
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 _ _ _ =
|
||||
error("hide_tvar_subst_return_ast_tr: error in parsing AST")
|
||||
|
||||
|
||||
end
|
||||
\<close>
|
||||
|
||||
|
||||
|
||||
subsection\<open>Register Parse Translations\<close>
|
||||
syntax "_tvars_wildcard" :: "type \<Rightarrow> type" ("'('_') _")
|
||||
syntax "_tvars_wildcard_retval" :: "type \<Rightarrow> type \<Rightarrow> type" ("'('_, _') _")
|
||||
syntax "_tvars_wildcard_sort" :: "sort \<Rightarrow> type \<Rightarrow> type" ("'('_::_') _")
|
||||
syntax "_tvars_wildcard_right" :: "type \<Rightarrow> type" ("_ '_..")
|
||||
syntax "_tvars_wildcard_left" :: "type \<Rightarrow> type" ("_ ..'_")
|
||||
|
||||
parse_ast_translation\<open>
|
||||
[
|
||||
(@{syntax_const "_tvars_wildcard_sort"}, Hide_Tvar.hide_tvar_ast_tr),
|
||||
(@{syntax_const "_tvars_wildcard"}, Hide_Tvar.hide_tvar_ast_tr),
|
||||
(@{syntax_const "_tvars_wildcard_retval"}, Hide_Tvar.hide_tvar_subst_return_ast_tr Hide_Tvar.right),
|
||||
(@{syntax_const "_tvars_wildcard_right"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.right),
|
||||
(@{syntax_const "_tvars_wildcard_left"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.left)
|
||||
]
|
||||
\<close>
|
||||
|
||||
subsection\<open>Register Top-Level Isar Commands\<close>
|
||||
ML\<open>
|
||||
val modeP = (Parse.$$$ "("
|
||||
|-- (Parse.name --| Parse.$$$ ","
|
||||
-- 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))))));
|
||||
|
||||
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))))));
|
||||
\<close>
|
||||
(*
|
||||
section\<open>Examples\<close>
|
||||
subsection\<open>Print Translation\<close>
|
||||
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 \<times> 'b) hide_tvar_foobar"
|
||||
|
||||
definition hide_tvar_f::"('a, 'b) hide_tvar_foobar \<Rightarrow> ('a, 'b) hide_tvar_foobar \<Rightarrow> ('a, 'b) hide_tvar_foobar"
|
||||
where "hide_tvar_f a b = a"
|
||||
definition hide_tvar_g::"('a, 'b, 'c, 'd) hide_tvar_baz \<Rightarrow> ('a, 'b, 'c, 'd) hide_tvar_baz \<Rightarrow> ('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",
|
||||
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",
|
||||
str="hide_tvar_g (a::('a + 'b, 'a \<times> 'b) hide_tvar_foobar) (b::('a + 'b, 'a \<times> 'b) hide_tvar_foobar) = a"]
|
||||
|
||||
register_default_tvars "('alpha, 'beta) hide_tvar_foobar" (print_all,parse)
|
||||
register_default_tvars "('alpha, 'beta, 'gamma, 'delta) hide_tvar_baz" (print_all,parse)
|
||||
|
||||
update_default_tvars_mode "_ hide_tvar_foobar" (noprint,noparse)
|
||||
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",
|
||||
str="hide_tvar_g (a::('a + 'b, 'a \<times> 'b) hide_tvar_foobar) (b::('a + 'b, 'a \<times> 'b) hide_tvar_foobar) = a"]
|
||||
|
||||
update_default_tvars_mode "_ hide_tvar_foobar" (print_all,noparse)
|
||||
|
||||
assert[string_of_thm_equal,
|
||||
thm_def="hide_tvar_f_def", str="hide_tvar_f (a::(_) hide_tvar_foobar) (b::(_) hide_tvar_foobar) = a"]
|
||||
assert[string_of_thm_equal,
|
||||
thm_def="hide_tvar_g_def", str="hide_tvar_g (a::(_) hide_tvar_baz) (b::(_) hide_tvar_baz) = a"]
|
||||
|
||||
subsection\<open>Parse Translation\<close>
|
||||
update_default_tvars_mode "_ hide_tvar_foobar" (print_all,parse)
|
||||
|
||||
declare [[show_types]]
|
||||
definition hide_tvar_A :: "'x \<Rightarrow> (('x::linorder) hide_tvar_foobar) .._"
|
||||
where "hide_tvar_A x = hide_tvar_foo 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_A' :: "'x \<Rightarrow> (('x,'b) hide_tvar_foobar) .._"
|
||||
where "hide_tvar_A' x = hide_tvar_foo 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 \<Rightarrow> (_) hide_tvar_foobar \<Rightarrow> (_) 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 \<Rightarrow> (_) hide_tvar_foobar \<Rightarrow> (_) 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 \<Rightarrow> (_) hide_tvar_foobar \<Rightarrow> (_) 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 \<Rightarrow> (_::linorder) hide_tvar_foobar \<Rightarrow> (_::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
|
||||
\<Rightarrow> (_,'retval) hide_tvar_foobar
|
||||
\<Rightarrow> (_,'retval) hide_tvar_baz"
|
||||
where "hide_tvar_X x y = x"
|
||||
*)
|
||||
(*>*)
|
||||
|
||||
subsection\<open>Introduction\<close>
|
||||
text\<open>
|
||||
When modelling object-oriented data models in HOL with the goal of preserving \<^emph>\<open>extensibility\<close>
|
||||
(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 \<open>all\<close>} type variables
|
||||
by \<open>(_)\<close>, e.g., a five-ary constructor \<open>('a, 'b, 'c, 'd, 'e) hide_tvar_foo\<close> can
|
||||
be shorted to \<open>(_) hide_tvar_foo\<close>. The use of this shorthand in output (printing) and
|
||||
input (parsing) is, on a per-type basis, user-configurable using the top-level commands
|
||||
\<open>register_default_tvars\<close> (for registering the names of the default type variables and
|
||||
the print/parse mode) and \<open>update_default_tvars_mode\<close> (for changing the print/parse mode
|
||||
dynamically).
|
||||
|
||||
The input also supports short-hands for declaring default sorts (e.g., \<open>(_::linorder)\<close>
|
||||
specifies that all default variables need to be instances of the sort (type class)
|
||||
@{class \<open>linorder\<close>} and short-hands of overriding a suffice (or prefix) of the default type
|
||||
variables. For example, \<open>('state) hide_tvar_foo _.\<close> is a short-hand for
|
||||
\<open>('a, 'b, 'c, 'd, 'state) hide_tvar_foo\<close>. In this document, we omit the implementation
|
||||
details (we refer the interested reader to theory file) and continue directly with a few
|
||||
examples.
|
||||
\<close>
|
||||
|
||||
subsection\<open>Example\<close>
|
||||
text\<open>Given the following type definition:\<close>
|
||||
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 \<times> 'b) hide_tvar_foobar"
|
||||
text\<open>We can register default values for the type variables for the abstract
|
||||
data type as well as the type synonym:\<close>
|
||||
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\<open>This allows us to write\<close>
|
||||
definition hide_tvar_f::"(_) hide_tvar_foobar \<Rightarrow> (_) hide_tvar_foobar \<Rightarrow> (_) hide_tvar_foobar"
|
||||
where "hide_tvar_f a b = a"
|
||||
definition hide_tvar_g::"(_) hide_tvar_baz \<Rightarrow> (_) hide_tvar_baz \<Rightarrow> (_) hide_tvar_baz"
|
||||
where "hide_tvar_g a b = a"
|
||||
|
||||
text\<open>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
|
||||
translation can be disabled for each type individually:\<close>
|
||||
|
||||
update_default_tvars_mode "_ hide_tvar_foobar" (noprint,noparse)
|
||||
update_default_tvars_mode "_ hide_tvar_foobar" (noprint,noparse)
|
||||
|
||||
text\<open> Now, Isabelle's interactive output and the antiquotations will show
|
||||
all type variables, e.g., @{term[show_types] "x = hide_tvar_g"}.\<close>
|
||||
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/preliminaries/Hiding_Type_Variables.thy
|
|
@ -1,92 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
theory Testing_Utils
|
||||
imports Main
|
||||
begin
|
||||
ML \<open>
|
||||
val _ = Theory.setup
|
||||
(Method.setup @{binding timed_code_simp}
|
||||
(Scan.succeed (SIMPLE_METHOD' o (CHANGED_PROP oo (fn a => fn b => fn tac =>
|
||||
let
|
||||
val start = Time.now ();
|
||||
val result = Code_Simp.dynamic_tac a b tac;
|
||||
val t = Time.now() - start;
|
||||
in
|
||||
(if length (Seq.list_of result) > 0 then Output.information ("Took " ^ (Time.toString t)) else ());
|
||||
result
|
||||
end))))
|
||||
"timed simplification with code equations");
|
||||
|
||||
val _ = Theory.setup
|
||||
(Method.setup @{binding timed_eval}
|
||||
(Scan.succeed (SIMPLE_METHOD' o (fn a => fn b => fn tac =>
|
||||
let
|
||||
val eval = CONVERSION (Conv.params_conv ~1 (K (Conv.concl_conv ~1 (Code_Runtime.dynamic_holds_conv a))) a) THEN'
|
||||
resolve_tac a [TrueI];
|
||||
val start = Time.now ();
|
||||
val result = eval b tac
|
||||
val t = Time.now() - start;
|
||||
in
|
||||
(if length (Seq.list_of result) > 0 then Output.information ("Took " ^ (Time.toString t)) else ());
|
||||
result
|
||||
end)))
|
||||
"timed evaluation");
|
||||
|
||||
val _ = Theory.setup
|
||||
(Method.setup @{binding timed_eval_and_code_simp}
|
||||
(Scan.succeed (SIMPLE_METHOD' o (fn a => fn b => fn tac =>
|
||||
let
|
||||
val eval = CONVERSION (Conv.params_conv ~1 (K (Conv.concl_conv ~1 (Code_Runtime.dynamic_holds_conv a))) a) THEN'
|
||||
resolve_tac a [TrueI];
|
||||
val start = Time.now ();
|
||||
val result = eval b tac
|
||||
val t = Time.now() - start;
|
||||
|
||||
val start2 = Time.now ();
|
||||
val result2_opt =
|
||||
Timeout.apply (seconds 600.0) (fn _ => SOME (Code_Simp.dynamic_tac a b tac)) ()
|
||||
handle Timeout.TIMEOUT _ => NONE;
|
||||
val t2 = Time.now() - start2;
|
||||
in
|
||||
if length (Seq.list_of result) > 0 then (Output.information ("eval took " ^ (Time.toString t)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t ^ ",")) else ();
|
||||
(case result2_opt of
|
||||
SOME result2 =>
|
||||
(if length (Seq.list_of result2) > 0 then (Output.information ("code_simp took " ^ (Time.toString t2)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t2 ^ "\n")) else ())
|
||||
| NONE => (Output.information "code_simp timed out after 600s"; File.append (Path.explode "/tmp/isabellebench") (">600.000\n")));
|
||||
result
|
||||
end)))
|
||||
"timed evaluation and simplification with code equations with file output");
|
||||
\<close>
|
||||
|
||||
(* To run the DOM test cases with timing information output, simply replace the use *)
|
||||
(* of "eval" with either "timed_code_simp", "timed_eval", or, to run both and write the results *)
|
||||
(* to /tmp/isabellebench, "timed_eval_and_code_simp". *)
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/preliminaries/Testing_Utils.thy
|
|
@ -1,273 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2018 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
section\<open>Common Test Setup\<close>
|
||||
text\<open>This theory provides the common test setup that is used by all formalized test cases.\<close>
|
||||
|
||||
theory Core_DOM_BaseTest
|
||||
imports
|
||||
(*<*)
|
||||
"../preliminaries/Testing_Utils"
|
||||
(*>*)
|
||||
"../Core_DOM"
|
||||
begin
|
||||
|
||||
definition "assert_throws e p = do {
|
||||
h \<leftarrow> get_heap;
|
||||
(if (h \<turnstile> p \<rightarrow>\<^sub>e e) then return () else error AssertException)
|
||||
}"
|
||||
notation assert_throws ("assert'_throws'(_, _')")
|
||||
|
||||
definition "test p h \<longleftrightarrow> h \<turnstile> ok p"
|
||||
|
||||
|
||||
definition field_access :: "(string \<Rightarrow> (_, (_) object_ptr option) dom_prog) \<Rightarrow> string
|
||||
\<Rightarrow> (_, (_) object_ptr option) dom_prog" (infix "." 80)
|
||||
where
|
||||
"field_access m field = m field"
|
||||
|
||||
definition assert_equals :: "'a \<Rightarrow> 'a \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"assert_equals l r = (if l = r then return () else error AssertException)"
|
||||
definition assert_equals_with_message :: "'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"assert_equals_with_message l r _ = (if l = r then return () else error AssertException)"
|
||||
notation assert_equals ("assert'_equals'(_, _')")
|
||||
notation assert_equals_with_message ("assert'_equals'(_, _, _')")
|
||||
notation assert_equals ("assert'_array'_equals'(_, _')")
|
||||
notation assert_equals_with_message ("assert'_array'_equals'(_, _, _')")
|
||||
|
||||
definition assert_not_equals :: "'a \<Rightarrow> 'a \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"assert_not_equals l r = (if l \<noteq> r then return () else error AssertException)"
|
||||
definition assert_not_equals_with_message :: "'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"assert_not_equals_with_message l r _ = (if l \<noteq> r then return () else error AssertException)"
|
||||
notation assert_not_equals ("assert'_not'_equals'(_, _')")
|
||||
notation assert_not_equals_with_message ("assert'_not'_equals'(_, _, _')")
|
||||
notation assert_not_equals ("assert'_array'_not'_equals'(_, _')")
|
||||
notation assert_not_equals_with_message ("assert'_array'_not'_equals'(_, _, _')")
|
||||
|
||||
definition removeWhiteSpaceOnlyTextNodes :: "((_) object_ptr option) \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"removeWhiteSpaceOnlyTextNodes _ = return ()"
|
||||
|
||||
|
||||
subsection \<open>Making the functions under test compatible with untyped languages such as JavaScript\<close>
|
||||
|
||||
fun set_attribute_with_null :: "((_) object_ptr option) \<Rightarrow> attr_key \<Rightarrow> attr_value \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"set_attribute_with_null (Some ptr) k v = (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> set_attribute element_ptr k (Some v))"
|
||||
fun set_attribute_with_null2 :: "((_) object_ptr option) \<Rightarrow> attr_key \<Rightarrow> attr_value option \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"set_attribute_with_null2 (Some ptr) k v = (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> set_attribute element_ptr k v)"
|
||||
notation set_attribute_with_null ("_ . setAttribute'(_, _')")
|
||||
notation set_attribute_with_null2 ("_ . setAttribute'(_, _')")
|
||||
|
||||
fun get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_with_null :: "((_) object_ptr option) \<Rightarrow> (_, (_) object_ptr option list) dom_prog"
|
||||
where
|
||||
"get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_with_null (Some ptr) = do {
|
||||
children \<leftarrow> get_child_nodes ptr;
|
||||
return (map (Some \<circ> cast) children)
|
||||
}"
|
||||
notation get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_with_null ("_ . childNodes")
|
||||
|
||||
fun create_element_with_null :: "((_) object_ptr option) \<Rightarrow> string \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"create_element_with_null (Some owner_document_obj) tag = (case cast owner_document_obj of
|
||||
Some owner_document \<Rightarrow> do {
|
||||
element_ptr \<leftarrow> create_element owner_document tag;
|
||||
return (Some (cast element_ptr))})"
|
||||
notation create_element_with_null ("_ . createElement'(_')")
|
||||
|
||||
fun create_character_data_with_null :: "((_) object_ptr option) \<Rightarrow> string \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"create_character_data_with_null (Some owner_document_obj) tag = (case cast owner_document_obj of
|
||||
Some owner_document \<Rightarrow> do {
|
||||
character_data_ptr \<leftarrow> create_character_data owner_document tag;
|
||||
return (Some (cast character_data_ptr))})"
|
||||
notation create_character_data_with_null ("_ . createTextNode'(_')")
|
||||
|
||||
definition create_document_with_null :: "string \<Rightarrow> (_, ((_::linorder) object_ptr option)) dom_prog"
|
||||
where
|
||||
"create_document_with_null title = do {
|
||||
new_document_ptr \<leftarrow> create_document;
|
||||
html \<leftarrow> create_element new_document_ptr ''html'';
|
||||
append_child (cast new_document_ptr) (cast html);
|
||||
heap \<leftarrow> create_element new_document_ptr ''heap'';
|
||||
append_child (cast html) (cast heap);
|
||||
body \<leftarrow> create_element new_document_ptr ''body'';
|
||||
append_child (cast html) (cast body);
|
||||
return (Some (cast new_document_ptr))
|
||||
}"
|
||||
abbreviation "create_document_with_null2 _ _ _ \<equiv> create_document_with_null ''''"
|
||||
notation create_document_with_null ("createDocument'(_')")
|
||||
notation create_document_with_null2 ("createDocument'(_, _, _')")
|
||||
|
||||
fun get_element_by_id_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> string \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"get_element_by_id_with_null (Some ptr) id' = do {
|
||||
element_ptr_opt \<leftarrow> get_element_by_id ptr id';
|
||||
(case element_ptr_opt of
|
||||
Some element_ptr \<Rightarrow> 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 element_ptr))
|
||||
| None \<Rightarrow> return None)}"
|
||||
| "get_element_by_id_with_null _ _ = error SegmentationFault"
|
||||
notation get_element_by_id_with_null ("_ . getElementById'(_')")
|
||||
|
||||
fun get_elements_by_class_name_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> string \<Rightarrow> (_, ((_) 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 \<bind> map_M (return \<circ> Some \<circ> 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) \<Rightarrow> string \<Rightarrow> (_, ((_) object_ptr option) list) dom_prog"
|
||||
where
|
||||
"get_elements_by_tag_name_with_null (Some ptr) tag_name =
|
||||
get_elements_by_tag_name ptr tag_name \<bind> map_M (return \<circ> Some \<circ> 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) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> (_, ((_) 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 \<Rightarrow> do {
|
||||
(case ref_child_obj_opt of
|
||||
Some ref_child_obj \<Rightarrow> insert_before ptr child (cast ref_child_obj)
|
||||
| None \<Rightarrow> insert_before ptr child None);
|
||||
return (Some child_obj)}
|
||||
| None \<Rightarrow> error HierarchyRequestError)"
|
||||
notation insert_before_with_null ("_ . insertBefore'(_, _')")
|
||||
|
||||
fun append_child_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> (_, unit) dom_prog"
|
||||
where
|
||||
"append_child_with_null (Some ptr) (Some child_obj) = (case cast child_obj of
|
||||
Some child \<Rightarrow> append_child ptr child
|
||||
| None \<Rightarrow> error SegmentationFault)"
|
||||
notation append_child_with_null ("_ . appendChild'(_')")
|
||||
|
||||
fun get_body :: "((_::linorder) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"get_body ptr = do {
|
||||
ptrs \<leftarrow> ptr . getElementsByTagName(''body'');
|
||||
return (hd ptrs)
|
||||
}"
|
||||
notation get_body ("_ . body")
|
||||
|
||||
fun get_document_element_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> (_, ((_) 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 \<Rightarrow> do {
|
||||
element_ptr_opt \<leftarrow> get_M document_ptr document_element;
|
||||
return (case element_ptr_opt of
|
||||
Some element_ptr \<Rightarrow> 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 element_ptr)
|
||||
| None \<Rightarrow> None)})"
|
||||
notation get_document_element_with_null ("_ . documentElement")
|
||||
|
||||
fun get_owner_document_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"get_owner_document_with_null (Some ptr) = (do {
|
||||
document_ptr \<leftarrow> 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) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"remove_with_null (Some ptr) (Some child) = (case cast child of
|
||||
Some child_node \<Rightarrow> do {
|
||||
remove child_node;
|
||||
return (Some child)}
|
||||
| None \<Rightarrow> error NotFoundError)"
|
||||
| "remove_with_null None _ = error TypeError"
|
||||
| "remove_with_null _ None = error TypeError"
|
||||
notation remove_with_null ("_ . remove'(')")
|
||||
|
||||
fun remove_child_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"remove_child_with_null (Some ptr) (Some child) = (case cast child of
|
||||
Some child_node \<Rightarrow> do {
|
||||
remove_child ptr child_node;
|
||||
return (Some child)}
|
||||
| None \<Rightarrow> error NotFoundError)"
|
||||
| "remove_child_with_null None _ = error TypeError"
|
||||
| "remove_child_with_null _ None = error TypeError"
|
||||
notation remove_child_with_null ("_ . removeChild")
|
||||
|
||||
fun get_tag_name_with_null :: "((_) object_ptr option) \<Rightarrow> (_, attr_value) dom_prog"
|
||||
where
|
||||
"get_tag_name_with_null (Some ptr) = (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> get_M element_ptr tag_type)"
|
||||
notation get_tag_name_with_null ("_ . tagName")
|
||||
|
||||
abbreviation "remove_attribute_with_null ptr k \<equiv> set_attribute_with_null2 ptr k None"
|
||||
notation remove_attribute_with_null ("_ . removeAttribute'(_')")
|
||||
|
||||
fun get_attribute_with_null :: "((_) object_ptr option) \<Rightarrow> attr_key \<Rightarrow> (_, attr_value option) dom_prog"
|
||||
where
|
||||
"get_attribute_with_null (Some ptr) k = (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> get_attribute element_ptr k)"
|
||||
fun get_attribute_with_null2 :: "((_) object_ptr option) \<Rightarrow> attr_key \<Rightarrow> (_, attr_value) dom_prog"
|
||||
where
|
||||
"get_attribute_with_null2 (Some ptr) k = (case cast ptr of
|
||||
Some element_ptr \<Rightarrow> do {
|
||||
a \<leftarrow> get_attribute element_ptr k;
|
||||
return (the a)})"
|
||||
notation get_attribute_with_null ("_ . getAttribute'(_')")
|
||||
notation get_attribute_with_null2 ("_ . getAttribute'(_')")
|
||||
|
||||
fun get_parent_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> (_, (_) object_ptr option) dom_prog"
|
||||
where
|
||||
"get_parent_with_null (Some ptr) = (case cast ptr of
|
||||
Some node_ptr \<Rightarrow> get_parent node_ptr)"
|
||||
notation get_parent_with_null ("_ . parentNode")
|
||||
|
||||
fun first_child_with_null :: "((_) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"first_child_with_null (Some ptr) = do {
|
||||
child_opt \<leftarrow> first_child ptr;
|
||||
return (case child_opt of
|
||||
Some child \<Rightarrow> Some (cast child)
|
||||
| None \<Rightarrow> None)}"
|
||||
notation first_child_with_null ("_ . firstChild")
|
||||
|
||||
fun adopt_node_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> ((_) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog"
|
||||
where
|
||||
"adopt_node_with_null (Some ptr) (Some child) = (case cast ptr of
|
||||
Some document_ptr \<Rightarrow> (case cast child of
|
||||
Some child_node \<Rightarrow> do {
|
||||
adopt_node document_ptr child_node;
|
||||
return (Some child)}))"
|
||||
notation adopt_node_with_null ("_ . adoptNode'(_')")
|
||||
|
||||
|
||||
definition createTestTree :: "((_::linorder) object_ptr option) \<Rightarrow> (_, (string \<Rightarrow> (_, ((_) object_ptr option)) dom_prog)) dom_prog"
|
||||
where
|
||||
"createTestTree ref = return (\<lambda>id. get_element_by_id_with_null ref id)"
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Core_DOM_BaseTest.thy
|
|
@ -1,36 +0,0 @@
|
|||
<!doctype html>
|
||||
<meta charset=utf-8>
|
||||
<title>Document.adoptNode</title>
|
||||
<link rel=help href="https://dom.spec.whatwg.org/#dom-document-adoptnode">
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<div id="log"></div>
|
||||
<x<>x</x<>
|
||||
<script>
|
||||
test(function() {
|
||||
var y = document.getElementsByTagName("x<")[0]
|
||||
var child = y.firstChild
|
||||
assert_equals(y.parentNode, document.body)
|
||||
assert_equals(y.ownerDocument, document)
|
||||
assert_equals(document.adoptNode(y), y)
|
||||
assert_equals(y.parentNode, null)
|
||||
assert_equals(y.firstChild, child)
|
||||
assert_equals(y.ownerDocument, document)
|
||||
assert_equals(child.ownerDocument, document)
|
||||
var doc = document.implementation.createDocument(null, null, null)
|
||||
assert_equals(doc.adoptNode(y), y)
|
||||
assert_equals(y.parentNode, null)
|
||||
assert_equals(y.firstChild, child)
|
||||
assert_equals(y.ownerDocument, doc)
|
||||
assert_equals(child.ownerDocument, doc)
|
||||
}, "Adopting an Element called 'x<' should work.")
|
||||
|
||||
test(function() {
|
||||
var x = document.createElement(":good:times:")
|
||||
assert_equals(document.adoptNode(x), x);
|
||||
var doc = document.implementation.createDocument(null, null, null)
|
||||
assert_equals(doc.adoptNode(x), x)
|
||||
assert_equals(x.parentNode, null)
|
||||
assert_equals(x.ownerDocument, doc)
|
||||
}, "Adopting an Element called ':good:times:' should work.")
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document-adoptNode.html
|
|
@ -1,50 +0,0 @@
|
|||
<!doctype html>
|
||||
<meta charset=utf-8>
|
||||
<title>Document.adoptNode</title>
|
||||
<link rel=help href="https://dom.spec.whatwg.org/#dom-document-adoptnode">
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<div id="log"></div>
|
||||
<!--creates an element with local name "x<": --><x<>x</x<>
|
||||
<script>
|
||||
test(function() {
|
||||
var y = document.getElementsByTagName("x<")[0]
|
||||
var child = y.firstChild
|
||||
assert_equals(y.parentNode, document.body)
|
||||
assert_equals(y.ownerDocument, document)
|
||||
assert_equals(document.adoptNode(y), y)
|
||||
assert_equals(y.parentNode, null)
|
||||
assert_equals(y.firstChild, child)
|
||||
assert_equals(y.ownerDocument, document)
|
||||
assert_equals(child.ownerDocument, document)
|
||||
var doc = document.implementation.createDocument(null, null, null)
|
||||
assert_equals(doc.adoptNode(y), y)
|
||||
assert_equals(y.parentNode, null)
|
||||
assert_equals(y.firstChild, child)
|
||||
assert_equals(y.ownerDocument, doc)
|
||||
assert_equals(child.ownerDocument, doc)
|
||||
}, "Adopting an Element called 'x<' should work.")
|
||||
|
||||
test(function() {
|
||||
var x = document.createElement(":good:times:")
|
||||
assert_equals(document.adoptNode(x), x);
|
||||
var doc = document.implementation.createDocument(null, null, null)
|
||||
assert_equals(doc.adoptNode(x), x)
|
||||
assert_equals(x.parentNode, null)
|
||||
assert_equals(x.ownerDocument, doc)
|
||||
}, "Adopting an Element called ':good:times:' should work.")
|
||||
|
||||
test(function() {
|
||||
var doctype = document.doctype;
|
||||
assert_equals(doctype.parentNode, document)
|
||||
assert_equals(doctype.ownerDocument, document)
|
||||
assert_equals(document.adoptNode(doctype), doctype)
|
||||
assert_equals(doctype.parentNode, null)
|
||||
assert_equals(doctype.ownerDocument, document)
|
||||
}, "Explicitly adopting a DocumentType should work.")
|
||||
|
||||
test(function() {
|
||||
var doc = document.implementation.createDocument(null, null, null)
|
||||
assert_throws("NOT_SUPPORTED_ERR", function() { document.adoptNode(doc) })
|
||||
}, "Adopting a Document should throw.")
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document-adoptNode.html.orig
|
|
@ -1,251 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<meta charset=utf-8>
|
||||
<title>Document.getElementById</title>
|
||||
<link rel="author" title="Tetsuharu OHZEKI" href="mailto:saneyuki.snyk@gmail.com">
|
||||
<link rel=help href="https://dom.spec.whatwg.org/#dom-document-getelementbyid">
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<body>
|
||||
<div id="log"></div>
|
||||
|
||||
<div id=""></div>
|
||||
|
||||
<div id="test1"></div>
|
||||
|
||||
<div id="test5" data-name="1st">
|
||||
<p id="test5" data-name="2nd">P</p>
|
||||
<input id="test5" type="submit" value="Submit" data-name="3rd">
|
||||
</div>
|
||||
|
||||
<div id="outer">
|
||||
<div id="middle">
|
||||
<div id="inner"></div>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<script>
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
var TEST_ID = "test2";
|
||||
|
||||
var test = document.createElement("div");
|
||||
test.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(test);
|
||||
|
||||
// test: appended element
|
||||
var result = document.getElementById(TEST_ID);
|
||||
assert_not_equals(result, null, "should not be null.");
|
||||
assert_equals(result.tagName, "div", "should have appended element's tag name");
|
||||
|
||||
// test: removed element
|
||||
gBody.removeChild(test);
|
||||
var removed = document.getElementById(TEST_ID);
|
||||
// `document.getElementById()` returns `null` if there is none.
|
||||
// https://dom.spec.whatwg.org/#dom-nonelementparentnode-getelementbyid
|
||||
assert_equals(removed, null, "should not get removed element.");
|
||||
}, "Document.getElementById with a script-inserted element");
|
||||
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
// setup fixtures.
|
||||
var TEST_ID = "test3";
|
||||
var test = document.createElement("div");
|
||||
test.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(test);
|
||||
|
||||
// update id
|
||||
var UPDATED_ID = "test3-updated";
|
||||
test.setAttribute("id", UPDATED_ID);
|
||||
var e = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, "should get the element with id.");
|
||||
|
||||
var old = document.getElementById(TEST_ID);
|
||||
assert_equals(old, null, "shouldn't get the element by the old id.");
|
||||
|
||||
// remove id.
|
||||
test.removeAttribute("id");
|
||||
var e2 = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e2, null, "should return null when the passed id is none in document.");
|
||||
}, "update `id` attribute via setAttribute/removeAttribute");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test4-should-not-exist";
|
||||
|
||||
var e = document.createElement('div');
|
||||
e.setAttribute("id", TEST_ID);
|
||||
|
||||
assert_equals(document.getElementById(TEST_ID), null, "should be null");
|
||||
document.body.appendChild(e);
|
||||
assert_equals(document.getElementById(TEST_ID), e, "should be the appended element");
|
||||
}, "Ensure that the id attribute only affects elements present in a document");
|
||||
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
// the method should return the 1st element.
|
||||
var TEST_ID = "test5";
|
||||
var target = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target, null, "should not be null");
|
||||
assert_equals(target.getAttribute("data-name"), "1st", "should return the 1st");
|
||||
|
||||
// even if after the new element was appended.
|
||||
var element4 = document.createElement("div");
|
||||
element4.setAttribute("id", TEST_ID);
|
||||
element4.setAttribute("data-name", "4th");
|
||||
gBody.appendChild(element4);
|
||||
var target2 = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target2, null, "should not be null");
|
||||
assert_equals(target2.getAttribute("data-name"), "1st", "should be the 1st");
|
||||
|
||||
// should return the next element after removed the subtree including the 1st element.
|
||||
target2.parentNode.removeChild(target2);
|
||||
var target3 = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target3, null, "should not be null");
|
||||
assert_equals(target3.getAttribute("data-name"), "4th", "should be the 4th");
|
||||
}, "in tree order, within the context object's tree");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test6";
|
||||
var s = document.createElement("div");
|
||||
s.setAttribute("id", TEST_ID);
|
||||
// append to Element, not Document.
|
||||
document.createElement("div").appendChild(s);
|
||||
|
||||
assert_equals(document.getElementById(TEST_ID), null, "should be null");
|
||||
}, "Modern browsers optimize this method with using internal id cache. This test checks that their optimization should effect only append to `Document`, not append to `Node`.");
|
||||
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
var TEST_ID = "test7"
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(element);
|
||||
|
||||
var target = document.getElementById(TEST_ID);
|
||||
assert_equals(target, element, "should return the element before changing the value");
|
||||
|
||||
element.setAttribute("id", TEST_ID + "-updated");
|
||||
var target2 = document.getElementById(TEST_ID);
|
||||
assert_equals(target2, null, "should return null after updated id via Attr.value");
|
||||
var target3 = document.getElementById(TEST_ID + "-updated");
|
||||
assert_equals(target3, element, "should be equal to the updated element.");
|
||||
}, "changing attribute's value via `Attr` gotten from `Element.attribute`.");
|
||||
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
// setup fixtures.
|
||||
var TEST_ID = "test12";
|
||||
var test = document.createElement("div");
|
||||
test.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(test);
|
||||
|
||||
// update id
|
||||
var UPDATED_ID = TEST_ID + "-updated";
|
||||
test.setAttribute("id", UPDATED_ID);
|
||||
var e = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, "should get the element with id.");
|
||||
|
||||
var old = document.getElementById(TEST_ID);
|
||||
assert_equals(old, null, "shouldn't get the element by the old id.");
|
||||
|
||||
// remove id.
|
||||
test.setAttribute("id", "");
|
||||
var e2 = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e2, null, "should return null when the passed id is none in document.");
|
||||
}, "update `id` attribute via element.id");
|
||||
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
var TEST_ID = "test13";
|
||||
|
||||
// create fixture
|
||||
var container = document.createElement("div");
|
||||
container.setAttribute("id", TEST_ID + "-fixture");
|
||||
gBody.appendChild(container);
|
||||
|
||||
var element1 = document.createElement("div");
|
||||
element1.setAttribute("id", TEST_ID);
|
||||
var element2 = document.createElement("div");
|
||||
element2.setAttribute("id", TEST_ID);
|
||||
var element3 = document.createElement("div");
|
||||
element3.setAttribute("id", TEST_ID);
|
||||
var element4 = document.createElement("div");
|
||||
element4.setAttribute("id", TEST_ID);
|
||||
|
||||
// append element: 2 -> 4 -> 3 -> 1
|
||||
container.appendChild(element2);
|
||||
container.appendChild(element4);
|
||||
container.insertBefore(element3, element4);
|
||||
container.insertBefore(element1, element2);
|
||||
|
||||
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element1, "should return 1st element");
|
||||
container.removeChild(element1);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element2, "should return 2nd element");
|
||||
container.removeChild(element2);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element3, "should return 3rd element");
|
||||
container.removeChild(element3);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element4, "should return 4th element");
|
||||
container.removeChild(element4);
|
||||
|
||||
|
||||
}, "where insertion order and tree order don't match");
|
||||
|
||||
test(function() {
|
||||
var gBody = document.body;
|
||||
|
||||
var TEST_ID = "test14";
|
||||
var a = document.createElement("a");
|
||||
var b = document.createElement("b");
|
||||
a.appendChild(b);
|
||||
b.setAttribute("id", TEST_ID);
|
||||
assert_equals(document.getElementById(TEST_ID), null);
|
||||
|
||||
gBody.appendChild(a);
|
||||
assert_equals(document.getElementById(TEST_ID), b);
|
||||
}, "Inserting an id by inserting its parent node");
|
||||
|
||||
test(function () {
|
||||
var TEST_ID = "test15"
|
||||
var outer = document.getElementById("outer");
|
||||
var middle = document.getElementById("middle");
|
||||
var inner = document.getElementById("inner");
|
||||
outer.removeChild(middle);
|
||||
|
||||
var new_el = document.createElement("h1");
|
||||
new_el.setAttribute("id", "heading");
|
||||
inner.appendChild(new_el);
|
||||
// the new element is not part of the document since
|
||||
// "middle" element was removed previously
|
||||
assert_equals(document.getElementById("heading"), null);
|
||||
}, "Document.getElementById must not return nodes not present in document");
|
||||
|
||||
// TODO:
|
||||
// id attribute in a namespace
|
||||
|
||||
|
||||
// TODO:
|
||||
// SVG + MathML elements with id attributes
|
||||
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document-getElementById.html
|
|
@ -1,350 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<meta charset=utf-8>
|
||||
<title>Document.getElementById</title>
|
||||
<link rel="author" title="Tetsuharu OHZEKI" href="mailto:saneyuki.snyk@gmail.com">
|
||||
<link rel=help href="https://dom.spec.whatwg.org/#dom-document-getelementbyid">
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<body>
|
||||
<div id="log"></div>
|
||||
|
||||
<!-- test 0 -->
|
||||
<div id=""></div>
|
||||
|
||||
<!-- test 1 -->
|
||||
<div id="test1"></div>
|
||||
|
||||
<!-- test 5 -->
|
||||
<div id="test5" data-name="1st">
|
||||
<p id="test5" data-name="2nd">P</p>
|
||||
<input id="test5" type="submit" value="Submit" data-name="3rd">
|
||||
</div>
|
||||
|
||||
<!-- test 15 -->
|
||||
<div id="outer">
|
||||
<div id="middle">
|
||||
<div id="inner"></div>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<script>
|
||||
var gBody = document.getElementsByTagName("body")[0];
|
||||
|
||||
test(function() {
|
||||
assert_equals(document.getElementById(""), null);
|
||||
}, "Calling document.getElementById with an empty string argument.");
|
||||
|
||||
test(function() {
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", "null");
|
||||
document.body.appendChild(element);
|
||||
this.add_cleanup(function() { document.body.removeChild(element) });
|
||||
assert_equals(document.getElementById(null), element);
|
||||
}, "Calling document.getElementById with a null argument.");
|
||||
|
||||
test(function() {
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", "undefined");
|
||||
document.body.appendChild(element);
|
||||
this.add_cleanup(function() { document.body.removeChild(element) });
|
||||
assert_equals(document.getElementById(undefined), element);
|
||||
}, "Calling document.getElementById with an undefined argument.");
|
||||
|
||||
|
||||
test(function() {
|
||||
var bar = document.getElementById("test1");
|
||||
assert_not_equals(bar, null, "should not be null");
|
||||
assert_equals(bar.tagName, "DIV", "should have expected tag name.");
|
||||
assert_true(bar instanceof HTMLDivElement, "should be a valid Element instance");
|
||||
}, "on static page");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test2";
|
||||
|
||||
var test = document.createElement("div");
|
||||
test.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(test);
|
||||
|
||||
// test: appended element
|
||||
var result = document.getElementById(TEST_ID);
|
||||
assert_not_equals(result, null, "should not be null.");
|
||||
assert_equals(result.tagName, "DIV", "should have appended element's tag name");
|
||||
assert_true(result instanceof HTMLDivElement, "should be a valid Element instance");
|
||||
|
||||
// test: removed element
|
||||
gBody.removeChild(test);
|
||||
var removed = document.getElementById(TEST_ID);
|
||||
// `document.getElementById()` returns `null` if there is none.
|
||||
// https://dom.spec.whatwg.org/#dom-nonelementparentnode-getelementbyid
|
||||
assert_equals(removed, null, "should not get removed element.");
|
||||
}, "Document.getElementById with a script-inserted element");
|
||||
|
||||
|
||||
test(function() {
|
||||
// setup fixtures.
|
||||
var TEST_ID = "test3";
|
||||
var test = document.createElement("div");
|
||||
test.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(test);
|
||||
|
||||
// update id
|
||||
var UPDATED_ID = "test3-updated";
|
||||
test.setAttribute("id", UPDATED_ID);
|
||||
var e = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, "should get the element with id.");
|
||||
|
||||
var old = document.getElementById(TEST_ID);
|
||||
assert_equals(old, null, "shouldn't get the element by the old id.");
|
||||
|
||||
// remove id.
|
||||
test.removeAttribute("id");
|
||||
var e2 = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e2, null, "should return null when the passed id is none in document.");
|
||||
}, "update `id` attribute via setAttribute/removeAttribute");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test4-should-not-exist";
|
||||
|
||||
var e = document.createElement('div');
|
||||
e.setAttribute("id", TEST_ID);
|
||||
|
||||
assert_equals(document.getElementById(TEST_ID), null, "should be null");
|
||||
document.body.appendChild(e);
|
||||
assert_equals(document.getElementById(TEST_ID), e, "should be the appended element");
|
||||
}, "Ensure that the id attribute only affects elements present in a document");
|
||||
|
||||
|
||||
test(function() {
|
||||
// the method should return the 1st element.
|
||||
var TEST_ID = "test5";
|
||||
var target = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target, null, "should not be null");
|
||||
assert_equals(target.getAttribute("data-name"), "1st", "should return the 1st");
|
||||
|
||||
// even if after the new element was appended.
|
||||
var element4 = document.createElement("div");
|
||||
element4.setAttribute("id", TEST_ID);
|
||||
element4.setAttribute("data-name", "4th");
|
||||
gBody.appendChild(element4);
|
||||
var target2 = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target2, null, "should not be null");
|
||||
assert_equals(target2.getAttribute("data-name"), "1st", "should be the 1st");
|
||||
|
||||
// should return the next element after removed the subtree including the 1st element.
|
||||
target2.parentNode.removeChild(target2);
|
||||
var target3 = document.getElementById(TEST_ID);
|
||||
assert_not_equals(target3, null, "should not be null");
|
||||
assert_equals(target3.getAttribute("data-name"), "4th", "should be the 4th");
|
||||
}, "in tree order, within the context object's tree");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test6";
|
||||
var s = document.createElement("div");
|
||||
s.setAttribute("id", TEST_ID);
|
||||
// append to Element, not Document.
|
||||
document.createElement("div").appendChild(s);
|
||||
|
||||
assert_equals(document.getElementById(TEST_ID), null, "should be null");
|
||||
}, "Modern browsers optimize this method with using internal id cache. " +
|
||||
"This test checks that their optimization should effect only append to `Document`, not append to `Node`.");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test7"
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(element);
|
||||
|
||||
var target = document.getElementById(TEST_ID);
|
||||
assert_equals(target, element, "should return the element before changing the value");
|
||||
|
||||
element.attributes[0].value = TEST_ID + "-updated";
|
||||
var target2 = document.getElementById(TEST_ID);
|
||||
assert_equals(target2, null, "should return null after updated id via Attr.value");
|
||||
var target3 = document.getElementById(TEST_ID + "-updated");
|
||||
assert_equals(target3, element, "should be equal to the updated element.");
|
||||
}, "changing attribute's value via `Attr` gotten from `Element.attribute`.");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test8";
|
||||
|
||||
// setup fixture
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID + "-fixture");
|
||||
gBody.appendChild(element);
|
||||
|
||||
// add id-ed element with using innerHTML
|
||||
element.innerHTML = "<div id='"+ TEST_ID +"'></div>";
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element.firstChild, "should not be null");
|
||||
assert_equals(test.tagName, "DIV", "should have expected tag name.");
|
||||
assert_true(test instanceof HTMLDivElement, "should be a valid Element instance");
|
||||
}, "add id attribute via innerHTML");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test9";
|
||||
|
||||
// add fixture
|
||||
var fixture = document.createElement("div");
|
||||
fixture.setAttribute("id", TEST_ID + "-fixture");
|
||||
gBody.appendChild(fixture);
|
||||
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID);
|
||||
fixture.appendChild(element);
|
||||
|
||||
// check 'getElementById' should get the 'element'
|
||||
assert_equals(document.getElementById(TEST_ID), element, "should not be null");
|
||||
|
||||
// remove id-ed element with using innerHTML (clear 'element')
|
||||
fixture.innerHTML = "";
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, null, "should be null.");
|
||||
}, "remove id attribute via innerHTML");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test10";
|
||||
|
||||
// setup fixture
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID + "-fixture");
|
||||
gBody.appendChild(element);
|
||||
|
||||
// add id-ed element with using outerHTML
|
||||
element.outerHTML = "<div id='"+ TEST_ID +"'></div>";
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_not_equals(test, null, "should not be null");
|
||||
assert_equals(test.tagName, "DIV", "should have expected tag name.");
|
||||
assert_true(test instanceof HTMLDivElement,"should be a valid Element instance");
|
||||
}, "add id attribute via outerHTML");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test11";
|
||||
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID);
|
||||
gBody.appendChild(element);
|
||||
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element, "should be equal to the appended element.");
|
||||
|
||||
// remove id-ed element with using outerHTML
|
||||
element.outerHTML = "<div></div>";
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, null, "should be null.");
|
||||
}, "remove id attribute via outerHTML");
|
||||
|
||||
|
||||
test(function() {
|
||||
// setup fixtures.
|
||||
var TEST_ID = "test12";
|
||||
var test = document.createElement("div");
|
||||
test.id = TEST_ID;
|
||||
gBody.appendChild(test);
|
||||
|
||||
// update id
|
||||
var UPDATED_ID = TEST_ID + "-updated";
|
||||
test.id = UPDATED_ID;
|
||||
var e = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, "should get the element with id.");
|
||||
|
||||
var old = document.getElementById(TEST_ID);
|
||||
assert_equals(old, null, "shouldn't get the element by the old id.");
|
||||
|
||||
// remove id.
|
||||
test.id = "";
|
||||
var e2 = document.getElementById(UPDATED_ID);
|
||||
assert_equals(e2, null, "should return null when the passed id is none in document.");
|
||||
}, "update `id` attribute via element.id");
|
||||
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test13";
|
||||
|
||||
var create_same_id_element = function (order) {
|
||||
var element = document.createElement("div");
|
||||
element.setAttribute("id", TEST_ID);
|
||||
element.setAttribute("data-order", order);// for debug
|
||||
return element;
|
||||
};
|
||||
|
||||
// create fixture
|
||||
var container = document.createElement("div");
|
||||
container.setAttribute("id", TEST_ID + "-fixture");
|
||||
gBody.appendChild(container);
|
||||
|
||||
var element1 = create_same_id_element("1");
|
||||
var element2 = create_same_id_element("2");
|
||||
var element3 = create_same_id_element("3");
|
||||
var element4 = create_same_id_element("4");
|
||||
|
||||
// append element: 2 -> 4 -> 3 -> 1
|
||||
container.appendChild(element2);
|
||||
container.appendChild(element4);
|
||||
container.insertBefore(element3, element4);
|
||||
container.insertBefore(element1, element2);
|
||||
|
||||
|
||||
var test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element1, "should return 1st element");
|
||||
container.removeChild(element1);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element2, "should return 2nd element");
|
||||
container.removeChild(element2);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element3, "should return 3rd element");
|
||||
container.removeChild(element3);
|
||||
|
||||
test = document.getElementById(TEST_ID);
|
||||
assert_equals(test, element4, "should return 4th element");
|
||||
container.removeChild(element4);
|
||||
|
||||
|
||||
}, "where insertion order and tree order don't match");
|
||||
|
||||
test(function() {
|
||||
var TEST_ID = "test14";
|
||||
var a = document.createElement("a");
|
||||
var b = document.createElement("b");
|
||||
a.appendChild(b);
|
||||
b.id = TEST_ID;
|
||||
assert_equals(document.getElementById(TEST_ID), null);
|
||||
|
||||
gBody.appendChild(a);
|
||||
assert_equals(document.getElementById(TEST_ID), b);
|
||||
}, "Inserting an id by inserting its parent node");
|
||||
|
||||
test(function () {
|
||||
var TEST_ID = "test15"
|
||||
var outer = document.getElementById("outer");
|
||||
var middle = document.getElementById("middle");
|
||||
var inner = document.getElementById("inner");
|
||||
outer.removeChild(middle);
|
||||
|
||||
var new_el = document.createElement("h1");
|
||||
new_el.id = "heading";
|
||||
inner.appendChild(new_el);
|
||||
// the new element is not part of the document since
|
||||
// "middle" element was removed previously
|
||||
assert_equals(document.getElementById("heading"), null);
|
||||
}, "Document.getElementById must not return nodes not present in document");
|
||||
|
||||
// TODO:
|
||||
// id attribute in a namespace
|
||||
|
||||
|
||||
// TODO:
|
||||
// SVG + MathML elements with id attributes
|
||||
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document-getElementById.html.orig
|
|
@ -1,113 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2019 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
(* This file is automatically generated, please do not modify! *)
|
||||
|
||||
section\<open>Testing Document\_adoptNode\<close>
|
||||
text\<open>This theory contains the test cases for Document\_adoptNode.\<close>
|
||||
|
||||
theory Document_adoptNode
|
||||
imports
|
||||
"Core_DOM_BaseTest"
|
||||
begin
|
||||
|
||||
definition Document_adoptNode_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where
|
||||
"Document_adoptNode_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])),
|
||||
(cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 8)] fmempty None)),
|
||||
(cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6), cast (element_ptr.Ref 7)] fmempty None)),
|
||||
(cast (element_ptr.Ref 3), cast (create_element_obj ''meta'' [] (fmap_of_list [(''charset'', ''utf-8'')]) None)),
|
||||
(cast (element_ptr.Ref 4), cast (create_element_obj ''title'' [cast (character_data_ptr.Ref 1)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 1), cast (create_character_data_obj ''Document.adoptNode'')),
|
||||
(cast (element_ptr.Ref 5), cast (create_element_obj ''link'' [] (fmap_of_list [(''rel'', ''help''), (''href'', ''https://dom.spec.whatwg.org/#dom-document-adoptnode'')]) None)),
|
||||
(cast (element_ptr.Ref 6), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharness.js'')]) None)),
|
||||
(cast (element_ptr.Ref 7), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharnessreport.js'')]) None)),
|
||||
(cast (element_ptr.Ref 8), cast (create_element_obj ''body'' [cast (element_ptr.Ref 9), cast (element_ptr.Ref 10), cast (element_ptr.Ref 11)] fmempty None)),
|
||||
(cast (element_ptr.Ref 9), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''log'')]) None)),
|
||||
(cast (element_ptr.Ref 10), cast (create_element_obj ''x<'' [cast (character_data_ptr.Ref 2)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''x'')),
|
||||
(cast (element_ptr.Ref 11), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 3)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 3), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]"
|
||||
|
||||
definition Document_adoptNode_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Document_adoptNode_document = Some (cast (document_ptr.Ref 1))"
|
||||
|
||||
|
||||
text \<open>"Adopting an Element called 'x<' should work."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
tmp0 \<leftarrow> Document_adoptNode_document . getElementsByTagName(''x<'');
|
||||
y \<leftarrow> return (tmp0 ! 0);
|
||||
child \<leftarrow> y . firstChild;
|
||||
tmp1 \<leftarrow> y . parentNode;
|
||||
tmp2 \<leftarrow> Document_adoptNode_document . body;
|
||||
assert_equals(tmp1, tmp2);
|
||||
tmp3 \<leftarrow> y . ownerDocument;
|
||||
assert_equals(tmp3, Document_adoptNode_document);
|
||||
tmp4 \<leftarrow> Document_adoptNode_document . adoptNode(y);
|
||||
assert_equals(tmp4, y);
|
||||
tmp5 \<leftarrow> y . parentNode;
|
||||
assert_equals(tmp5, None);
|
||||
tmp6 \<leftarrow> y . firstChild;
|
||||
assert_equals(tmp6, child);
|
||||
tmp7 \<leftarrow> y . ownerDocument;
|
||||
assert_equals(tmp7, Document_adoptNode_document);
|
||||
tmp8 \<leftarrow> child . ownerDocument;
|
||||
assert_equals(tmp8, Document_adoptNode_document);
|
||||
doc \<leftarrow> createDocument(None, None, None);
|
||||
tmp9 \<leftarrow> doc . adoptNode(y);
|
||||
assert_equals(tmp9, y);
|
||||
tmp10 \<leftarrow> y . parentNode;
|
||||
assert_equals(tmp10, None);
|
||||
tmp11 \<leftarrow> y . firstChild;
|
||||
assert_equals(tmp11, child);
|
||||
tmp12 \<leftarrow> y . ownerDocument;
|
||||
assert_equals(tmp12, doc);
|
||||
tmp13 \<leftarrow> child . ownerDocument;
|
||||
assert_equals(tmp13, doc)
|
||||
}) Document_adoptNode_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Adopting an Element called ':good:times:' should work."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
x \<leftarrow> Document_adoptNode_document . createElement('':good:times:'');
|
||||
tmp0 \<leftarrow> Document_adoptNode_document . adoptNode(x);
|
||||
assert_equals(tmp0, x);
|
||||
doc \<leftarrow> createDocument(None, None, None);
|
||||
tmp1 \<leftarrow> doc . adoptNode(x);
|
||||
assert_equals(tmp1, x);
|
||||
tmp2 \<leftarrow> x . parentNode;
|
||||
assert_equals(tmp2, None);
|
||||
tmp3 \<leftarrow> x . ownerDocument;
|
||||
assert_equals(tmp3, doc)
|
||||
}) Document_adoptNode_heap"
|
||||
by eval
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document_adoptNode.thy
|
|
@ -1,277 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2019 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
(* This file is automatically generated, please do not modify! *)
|
||||
|
||||
section\<open>Testing Document\_getElementById\<close>
|
||||
text\<open>This theory contains the test cases for Document\_getElementById.\<close>
|
||||
|
||||
theory Document_getElementById
|
||||
imports
|
||||
"Core_DOM_BaseTest"
|
||||
begin
|
||||
|
||||
definition Document_getElementById_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where
|
||||
"Document_getElementById_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])),
|
||||
(cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 9)] fmempty None)),
|
||||
(cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6), cast (element_ptr.Ref 7), cast (element_ptr.Ref 8)] fmempty None)),
|
||||
(cast (element_ptr.Ref 3), cast (create_element_obj ''meta'' [] (fmap_of_list [(''charset'', ''utf-8'')]) None)),
|
||||
(cast (element_ptr.Ref 4), cast (create_element_obj ''title'' [cast (character_data_ptr.Ref 1)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 1), cast (create_character_data_obj ''Document.getElementById'')),
|
||||
(cast (element_ptr.Ref 5), cast (create_element_obj ''link'' [] (fmap_of_list [(''rel'', ''author''), (''title'', ''Tetsuharu OHZEKI''), (''href'', ''mailto:saneyuki.snyk@gmail.com'')]) None)),
|
||||
(cast (element_ptr.Ref 6), cast (create_element_obj ''link'' [] (fmap_of_list [(''rel'', ''help''), (''href'', ''https://dom.spec.whatwg.org/#dom-document-getelementbyid'')]) None)),
|
||||
(cast (element_ptr.Ref 7), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharness.js'')]) None)),
|
||||
(cast (element_ptr.Ref 8), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharnessreport.js'')]) None)),
|
||||
(cast (element_ptr.Ref 9), cast (create_element_obj ''body'' [cast (element_ptr.Ref 10), cast (element_ptr.Ref 11), cast (element_ptr.Ref 12), cast (element_ptr.Ref 13), cast (element_ptr.Ref 16), cast (element_ptr.Ref 19)] fmempty None)),
|
||||
(cast (element_ptr.Ref 10), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''log'')]) None)),
|
||||
(cast (element_ptr.Ref 11), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', '''')]) None)),
|
||||
(cast (element_ptr.Ref 12), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''test1'')]) None)),
|
||||
(cast (element_ptr.Ref 13), cast (create_element_obj ''div'' [cast (element_ptr.Ref 14), cast (element_ptr.Ref 15)] (fmap_of_list [(''id'', ''test5''), (''data-name'', ''1st'')]) None)),
|
||||
(cast (element_ptr.Ref 14), cast (create_element_obj ''p'' [cast (character_data_ptr.Ref 2)] (fmap_of_list [(''id'', ''test5''), (''data-name'', ''2nd'')]) None)),
|
||||
(cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''P'')),
|
||||
(cast (element_ptr.Ref 15), cast (create_element_obj ''input'' [] (fmap_of_list [(''id'', ''test5''), (''type'', ''submit''), (''value'', ''Submit''), (''data-name'', ''3rd'')]) None)),
|
||||
(cast (element_ptr.Ref 16), cast (create_element_obj ''div'' [cast (element_ptr.Ref 17)] (fmap_of_list [(''id'', ''outer'')]) None)),
|
||||
(cast (element_ptr.Ref 17), cast (create_element_obj ''div'' [cast (element_ptr.Ref 18)] (fmap_of_list [(''id'', ''middle'')]) None)),
|
||||
(cast (element_ptr.Ref 18), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''inner'')]) None)),
|
||||
(cast (element_ptr.Ref 19), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 3)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 3), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]"
|
||||
|
||||
definition Document_getElementById_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Document_getElementById_document = Some (cast (document_ptr.Ref 1))"
|
||||
|
||||
|
||||
text \<open>"Document.getElementById with a script-inserted element"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test2'';
|
||||
test \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
test . setAttribute(''id'', TEST_ID);
|
||||
gBody . appendChild(test);
|
||||
result \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_not_equals(result, None, ''should not be null.'');
|
||||
tmp0 \<leftarrow> result . tagName;
|
||||
assert_equals(tmp0, ''div'', ''should have appended element's tag name'');
|
||||
gBody . removeChild(test);
|
||||
removed \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(removed, None, ''should not get removed element.'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"update `id` attribute via setAttribute/removeAttribute"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test3'';
|
||||
test \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
test . setAttribute(''id'', TEST_ID);
|
||||
gBody . appendChild(test);
|
||||
UPDATED_ID \<leftarrow> return ''test3-updated'';
|
||||
test . setAttribute(''id'', UPDATED_ID);
|
||||
e \<leftarrow> Document_getElementById_document . getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, ''should get the element with id.'');
|
||||
old \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(old, None, ''shouldn't get the element by the old id.'');
|
||||
test . removeAttribute(''id'');
|
||||
e2 \<leftarrow> Document_getElementById_document . getElementById(UPDATED_ID);
|
||||
assert_equals(e2, None, ''should return null when the passed id is none in document.'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Ensure that the id attribute only affects elements present in a document"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
TEST_ID \<leftarrow> return ''test4-should-not-exist'';
|
||||
e \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
e . setAttribute(''id'', TEST_ID);
|
||||
tmp0 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(tmp0, None, ''should be null'');
|
||||
tmp1 \<leftarrow> Document_getElementById_document . body;
|
||||
tmp1 . appendChild(e);
|
||||
tmp2 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(tmp2, e, ''should be the appended element'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"in tree order, within the context object's tree"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test5'';
|
||||
target \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_not_equals(target, None, ''should not be null'');
|
||||
tmp0 \<leftarrow> target . getAttribute(''data-name'');
|
||||
assert_equals(tmp0, ''1st'', ''should return the 1st'');
|
||||
element4 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element4 . setAttribute(''id'', TEST_ID);
|
||||
element4 . setAttribute(''data-name'', ''4th'');
|
||||
gBody . appendChild(element4);
|
||||
target2 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_not_equals(target2, None, ''should not be null'');
|
||||
tmp1 \<leftarrow> target2 . getAttribute(''data-name'');
|
||||
assert_equals(tmp1, ''1st'', ''should be the 1st'');
|
||||
tmp2 \<leftarrow> target2 . parentNode;
|
||||
tmp2 . removeChild(target2);
|
||||
target3 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_not_equals(target3, None, ''should not be null'');
|
||||
tmp3 \<leftarrow> target3 . getAttribute(''data-name'');
|
||||
assert_equals(tmp3, ''4th'', ''should be the 4th'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Modern browsers optimize this method with using internal id cache. This test checks that their optimization should effect only append to `Document`, not append to `Node`."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
TEST_ID \<leftarrow> return ''test6'';
|
||||
s \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
s . setAttribute(''id'', TEST_ID);
|
||||
tmp0 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
tmp0 . appendChild(s);
|
||||
tmp1 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(tmp1, None, ''should be null'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"changing attribute's value via `Attr` gotten from `Element.attribute`."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test7'';
|
||||
element \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element . setAttribute(''id'', TEST_ID);
|
||||
gBody . appendChild(element);
|
||||
target \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(target, element, ''should return the element before changing the value'');
|
||||
element . setAttribute(''id'', (TEST_ID @ ''-updated''));
|
||||
target2 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(target2, None, ''should return null after updated id via Attr.value'');
|
||||
target3 \<leftarrow> Document_getElementById_document . getElementById((TEST_ID @ ''-updated''));
|
||||
assert_equals(target3, element, ''should be equal to the updated element.'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"update `id` attribute via element.id"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test12'';
|
||||
test \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
test . setAttribute(''id'', TEST_ID);
|
||||
gBody . appendChild(test);
|
||||
UPDATED_ID \<leftarrow> return (TEST_ID @ ''-updated'');
|
||||
test . setAttribute(''id'', UPDATED_ID);
|
||||
e \<leftarrow> Document_getElementById_document . getElementById(UPDATED_ID);
|
||||
assert_equals(e, test, ''should get the element with id.'');
|
||||
old \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(old, None, ''shouldn't get the element by the old id.'');
|
||||
test . setAttribute(''id'', '''');
|
||||
e2 \<leftarrow> Document_getElementById_document . getElementById(UPDATED_ID);
|
||||
assert_equals(e2, None, ''should return null when the passed id is none in document.'')
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"where insertion order and tree order don't match"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test13'';
|
||||
container \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
container . setAttribute(''id'', (TEST_ID @ ''-fixture''));
|
||||
gBody . appendChild(container);
|
||||
element1 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element1 . setAttribute(''id'', TEST_ID);
|
||||
element2 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element2 . setAttribute(''id'', TEST_ID);
|
||||
element3 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element3 . setAttribute(''id'', TEST_ID);
|
||||
element4 \<leftarrow> Document_getElementById_document . createElement(''div'');
|
||||
element4 . setAttribute(''id'', TEST_ID);
|
||||
container . appendChild(element2);
|
||||
container . appendChild(element4);
|
||||
container . insertBefore(element3, element4);
|
||||
container . insertBefore(element1, element2);
|
||||
test \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(test, element1, ''should return 1st element'');
|
||||
container . removeChild(element1);
|
||||
test \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(test, element2, ''should return 2nd element'');
|
||||
container . removeChild(element2);
|
||||
test \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(test, element3, ''should return 3rd element'');
|
||||
container . removeChild(element3);
|
||||
test \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(test, element4, ''should return 4th element'');
|
||||
container . removeChild(element4)
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Inserting an id by inserting its parent node"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
gBody \<leftarrow> Document_getElementById_document . body;
|
||||
TEST_ID \<leftarrow> return ''test14'';
|
||||
a \<leftarrow> Document_getElementById_document . createElement(''a'');
|
||||
b \<leftarrow> Document_getElementById_document . createElement(''b'');
|
||||
a . appendChild(b);
|
||||
b . setAttribute(''id'', TEST_ID);
|
||||
tmp0 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(tmp0, None);
|
||||
gBody . appendChild(a);
|
||||
tmp1 \<leftarrow> Document_getElementById_document . getElementById(TEST_ID);
|
||||
assert_equals(tmp1, b)
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Document.getElementById must not return nodes not present in document"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
TEST_ID \<leftarrow> return ''test15'';
|
||||
outer \<leftarrow> Document_getElementById_document . getElementById(''outer'');
|
||||
middle \<leftarrow> Document_getElementById_document . getElementById(''middle'');
|
||||
inner \<leftarrow> Document_getElementById_document . getElementById(''inner'');
|
||||
tmp0 \<leftarrow> Document_getElementById_document . getElementById(''middle'');
|
||||
outer . removeChild(tmp0);
|
||||
new_el \<leftarrow> Document_getElementById_document . createElement(''h1'');
|
||||
new_el . setAttribute(''id'', ''heading'');
|
||||
inner . appendChild(new_el);
|
||||
tmp1 \<leftarrow> Document_getElementById_document . getElementById(''heading'');
|
||||
assert_equals(tmp1, None)
|
||||
}) Document_getElementById_heap"
|
||||
by eval
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Document_getElementById.thy
|
|
@ -1,288 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<title>Node.insertBefore</title>
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<body>
|
||||
<div id="log"></div>
|
||||
</body>
|
||||
<script>
|
||||
test(function() {
|
||||
var node = document.createTextNode("Foo");
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { node.insertBefore(document.createTextNode("fail"), null) })
|
||||
|
||||
}, "Calling insertBefore an a leaf node Text must throw HIERARCHY_REQUEST_ERR.")
|
||||
|
||||
|
||||
test(function() {
|
||||
// Step 2.
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { document.body.insertBefore(document.body, document.getElementById("log")) })
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { document.body.insertBefore(document.documentElement, document.getElementById("log")) })
|
||||
}, "Calling insertBefore with an inclusive ancestor of the context object must throw HIERARCHY_REQUEST_ERR.")
|
||||
|
||||
// Step 3.
|
||||
test(function() {
|
||||
var a = document.createElement("div");
|
||||
var b = document.createElement("div");
|
||||
var c = document.createElement("div");
|
||||
assert_throws("NotFoundError", function() {
|
||||
a.insertBefore(b, c);
|
||||
});
|
||||
}, "Calling insertBefore with a reference child whose parent is not the context node must throw a NotFoundError.")
|
||||
|
||||
// Step 4.1.
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var doc2 = document.implementation.createHTMLDocument("title2");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doc2, doc.documentElement);
|
||||
});
|
||||
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doc.createTextNode("text"), doc.documentElement);
|
||||
});
|
||||
}, "If the context node is a document, inserting a document or text node should throw a HierarchyRequestError.")
|
||||
//
|
||||
// // Step 4.2.1.
|
||||
// test(function() {
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// doc.removeChild(doc.documentElement);
|
||||
//
|
||||
// var df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createElement("a"));
|
||||
// df.appendChild(doc.createElement("b"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, null);
|
||||
// });
|
||||
//
|
||||
// df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createTextNode("text"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, null);
|
||||
// });
|
||||
//
|
||||
// df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createComment("comment"));
|
||||
// df.appendChild(doc.createTextNode("text"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, null);
|
||||
// });
|
||||
// }, "If the context node is a document, appending a DocumentFragment that contains a text node or too many elements should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// doc.removeChild(doc.documentElement);
|
||||
//
|
||||
// var df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createElement("a"));
|
||||
// df.appendChild(doc.createElement("b"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.firstChild);
|
||||
// });
|
||||
//
|
||||
// df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createTextNode("text"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.firstChild);
|
||||
// });
|
||||
//
|
||||
// df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createComment("comment"));
|
||||
// df.appendChild(doc.createTextNode("text"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.firstChild);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting a DocumentFragment that contains a text node or too many elements should throw a HierarchyRequestError.")
|
||||
//
|
||||
// // Step 4.2.2.
|
||||
// test(function() {
|
||||
// // The context node has an element child.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.appendChild(doc.createComment("foo"));
|
||||
// assert_array_equals(doc.childNodes, [doc.doctype, doc.documentElement, comment]);
|
||||
//
|
||||
// var df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createElement("a"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.doctype);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.documentElement);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, comment);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, null);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting a DocumentFragment with an element if there already is an element child should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// // /child/ is a doctype.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
// doc.removeChild(doc.documentElement);
|
||||
// assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
//
|
||||
// var df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createElement("a"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, doc.doctype);
|
||||
// });
|
||||
// }, "If the context node is a document and a doctype is following the reference child, inserting a DocumentFragment with an element should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// // /child/ is not null and a doctype is following /child/.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
// doc.removeChild(doc.documentElement);
|
||||
// assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
//
|
||||
// var df = doc.createDocumentFragment();
|
||||
// df.appendChild(doc.createElement("a"));
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(df, comment);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting a DocumentFragment with an element before the doctype should throw a HierarchyRequestError.")
|
||||
//
|
||||
// // Step 4.3.
|
||||
// test(function() {
|
||||
// // The context node has an element child.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.appendChild(doc.createComment("foo"));
|
||||
// assert_array_equals(doc.childNodes, [doc.doctype, doc.documentElement, comment]);
|
||||
//
|
||||
// var a = doc.createElement("a");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, doc.doctype);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, doc.documentElement);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, comment);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, null);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting an element if there already is an element child should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// // /child/ is a doctype.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
// doc.removeChild(doc.documentElement);
|
||||
// assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
//
|
||||
// var a = doc.createElement("a");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, doc.doctype);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting an element before the doctype should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// // /child/ is not null and a doctype is following /child/.
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
// doc.removeChild(doc.documentElement);
|
||||
// assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
//
|
||||
// var a = doc.createElement("a");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(a, comment);
|
||||
// });
|
||||
// }, "If the context node is a document and a doctype is following the reference child, inserting an element should throw a HierarchyRequestError.")
|
||||
//
|
||||
// // Step 4.4.
|
||||
// test(function() {
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
// assert_array_equals(doc.childNodes, [comment, doc.doctype, doc.documentElement]);
|
||||
//
|
||||
// var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, comment);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, doc.doctype);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, doc.documentElement);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, null);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting a doctype if there already is a doctype child should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.appendChild(doc.createComment("foo"));
|
||||
// doc.removeChild(doc.doctype);
|
||||
// assert_array_equals(doc.childNodes, [doc.documentElement, comment]);
|
||||
//
|
||||
// var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, comment);
|
||||
// });
|
||||
// }, "If the context node is a document, inserting a doctype after the document element should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// var comment = doc.appendChild(doc.createComment("foo"));
|
||||
// doc.removeChild(doc.doctype);
|
||||
// assert_array_equals(doc.childNodes, [doc.documentElement, comment]);
|
||||
//
|
||||
// var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// doc.insertBefore(doctype, null);
|
||||
// });
|
||||
// }, "If the context node is a document with and element child, appending a doctype should throw a HierarchyRequestError.")
|
||||
//
|
||||
// // Step 5.
|
||||
// test(function() {
|
||||
// var df = document.createDocumentFragment();
|
||||
// var a = df.appendChild(document.createElement("a"));
|
||||
//
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// df.insertBefore(doc, a);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// df.insertBefore(doc, null);
|
||||
// });
|
||||
//
|
||||
// var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// df.insertBefore(doctype, a);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// df.insertBefore(doctype, null);
|
||||
// });
|
||||
// }, "If the context node is a DocumentFragment, inserting a document or a doctype should throw a HierarchyRequestError.")
|
||||
// test(function() {
|
||||
// var el = document.createElement("div");
|
||||
// var a = el.appendChild(document.createElement("a"));
|
||||
//
|
||||
// var doc = document.implementation.createHTMLDocument("title");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// el.insertBefore(doc, a);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// el.insertBefore(doc, null);
|
||||
// });
|
||||
//
|
||||
// var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// el.insertBefore(doctype, a);
|
||||
// });
|
||||
// assert_throws("HierarchyRequestError", function() {
|
||||
// el.insertBefore(doctype, null);
|
||||
// });
|
||||
// }, "If the context node is an element, inserting a document or a doctype should throw a HierarchyRequestError.")
|
||||
//
|
||||
// Step 7.
|
||||
test(function() {
|
||||
var a = document.createElement("div");
|
||||
var b = document.createElement("div");
|
||||
var c = document.createElement("div");
|
||||
a.appendChild(b);
|
||||
a.appendChild(c);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
assert_equals(a.insertBefore(b, b), b);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
assert_equals(a.insertBefore(c, c), c);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
}, "Inserting a node before itself should not move the node");
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node-insertBefore.html
|
|
@ -1,306 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<title>Node.insertBefore</title>
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<div id="log"></div>
|
||||
<script>
|
||||
function testLeafNode(nodeName, createNodeFunction) {
|
||||
test(function() {
|
||||
var node = createNodeFunction();
|
||||
assert_throws(new TypeError(), function() { node.insertBefore(null, null) })
|
||||
}, "Calling insertBefore with a non-Node first argument on a leaf node " + nodeName + " must throw TypeError.")
|
||||
test(function() {
|
||||
var node = createNodeFunction();
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { node.insertBefore(document.createTextNode("fail"), null) })
|
||||
// Would be step 2.
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { node.insertBefore(node, null) })
|
||||
// Would be step 3.
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { node.insertBefore(node, document.createTextNode("child")) })
|
||||
}, "Calling insertBefore an a leaf node " + nodeName + " must throw HIERARCHY_REQUEST_ERR.")
|
||||
}
|
||||
|
||||
test(function() {
|
||||
// WebIDL.
|
||||
assert_throws(new TypeError(), function() { document.body.insertBefore(null, null) })
|
||||
assert_throws(new TypeError(), function() { document.body.insertBefore(null, document.body.firstChild) })
|
||||
assert_throws(new TypeError(), function() { document.body.insertBefore({'a':'b'}, document.body.firstChild) })
|
||||
}, "Calling insertBefore with a non-Node first argument must throw TypeError.")
|
||||
|
||||
testLeafNode("DocumentType", function () { return document.doctype; } )
|
||||
testLeafNode("Text", function () { return document.createTextNode("Foo") })
|
||||
testLeafNode("Comment", function () { return document.createComment("Foo") })
|
||||
testLeafNode("ProcessingInstruction", function () { return document.createProcessingInstruction("foo", "bar") })
|
||||
|
||||
test(function() {
|
||||
// Step 2.
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { document.body.insertBefore(document.body, document.getElementById("log")) })
|
||||
assert_throws("HIERARCHY_REQUEST_ERR", function() { document.body.insertBefore(document.documentElement, document.getElementById("log")) })
|
||||
}, "Calling insertBefore with an inclusive ancestor of the context object must throw HIERARCHY_REQUEST_ERR.")
|
||||
|
||||
// Step 3.
|
||||
test(function() {
|
||||
var a = document.createElement("div");
|
||||
var b = document.createElement("div");
|
||||
var c = document.createElement("div");
|
||||
assert_throws("NotFoundError", function() {
|
||||
a.insertBefore(b, c);
|
||||
});
|
||||
}, "Calling insertBefore with a reference child whose parent is not the context node must throw a NotFoundError.")
|
||||
|
||||
// Step 4.1.
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var doc2 = document.implementation.createHTMLDocument("title2");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doc2, doc.documentElement);
|
||||
});
|
||||
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doc.createTextNode("text"), doc.documentElement);
|
||||
});
|
||||
}, "If the context node is a document, inserting a document or text node should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 4.2.1.
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
doc.removeChild(doc.documentElement);
|
||||
|
||||
var df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createElement("a"));
|
||||
df.appendChild(doc.createElement("b"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, null);
|
||||
});
|
||||
|
||||
df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createTextNode("text"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, null);
|
||||
});
|
||||
|
||||
df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createComment("comment"));
|
||||
df.appendChild(doc.createTextNode("text"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, null);
|
||||
});
|
||||
}, "If the context node is a document, appending a DocumentFragment that contains a text node or too many elements should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
doc.removeChild(doc.documentElement);
|
||||
|
||||
var df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createElement("a"));
|
||||
df.appendChild(doc.createElement("b"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.firstChild);
|
||||
});
|
||||
|
||||
df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createTextNode("text"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.firstChild);
|
||||
});
|
||||
|
||||
df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createComment("comment"));
|
||||
df.appendChild(doc.createTextNode("text"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.firstChild);
|
||||
});
|
||||
}, "If the context node is a document, inserting a DocumentFragment that contains a text node or too many elements should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 4.2.2.
|
||||
test(function() {
|
||||
// The context node has an element child.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.appendChild(doc.createComment("foo"));
|
||||
assert_array_equals(doc.childNodes, [doc.doctype, doc.documentElement, comment]);
|
||||
|
||||
var df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createElement("a"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.doctype);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.documentElement);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, comment);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, null);
|
||||
});
|
||||
}, "If the context node is a document, inserting a DocumentFragment with an element if there already is an element child should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
// /child/ is a doctype.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
doc.removeChild(doc.documentElement);
|
||||
assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
|
||||
var df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createElement("a"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, doc.doctype);
|
||||
});
|
||||
}, "If the context node is a document and a doctype is following the reference child, inserting a DocumentFragment with an element should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
// /child/ is not null and a doctype is following /child/.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
doc.removeChild(doc.documentElement);
|
||||
assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
|
||||
var df = doc.createDocumentFragment();
|
||||
df.appendChild(doc.createElement("a"));
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(df, comment);
|
||||
});
|
||||
}, "If the context node is a document, inserting a DocumentFragment with an element before the doctype should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 4.3.
|
||||
test(function() {
|
||||
// The context node has an element child.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.appendChild(doc.createComment("foo"));
|
||||
assert_array_equals(doc.childNodes, [doc.doctype, doc.documentElement, comment]);
|
||||
|
||||
var a = doc.createElement("a");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, doc.doctype);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, doc.documentElement);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, comment);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, null);
|
||||
});
|
||||
}, "If the context node is a document, inserting an element if there already is an element child should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
// /child/ is a doctype.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
doc.removeChild(doc.documentElement);
|
||||
assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
|
||||
var a = doc.createElement("a");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, doc.doctype);
|
||||
});
|
||||
}, "If the context node is a document, inserting an element before the doctype should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
// /child/ is not null and a doctype is following /child/.
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
doc.removeChild(doc.documentElement);
|
||||
assert_array_equals(doc.childNodes, [comment, doc.doctype]);
|
||||
|
||||
var a = doc.createElement("a");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(a, comment);
|
||||
});
|
||||
}, "If the context node is a document and a doctype is following the reference child, inserting an element should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 4.4.
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.insertBefore(doc.createComment("foo"), doc.firstChild);
|
||||
assert_array_equals(doc.childNodes, [comment, doc.doctype, doc.documentElement]);
|
||||
|
||||
var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, comment);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, doc.doctype);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, doc.documentElement);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, null);
|
||||
});
|
||||
}, "If the context node is a document, inserting a doctype if there already is a doctype child should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.appendChild(doc.createComment("foo"));
|
||||
doc.removeChild(doc.doctype);
|
||||
assert_array_equals(doc.childNodes, [doc.documentElement, comment]);
|
||||
|
||||
var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, comment);
|
||||
});
|
||||
}, "If the context node is a document, inserting a doctype after the document element should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
var comment = doc.appendChild(doc.createComment("foo"));
|
||||
doc.removeChild(doc.doctype);
|
||||
assert_array_equals(doc.childNodes, [doc.documentElement, comment]);
|
||||
|
||||
var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
doc.insertBefore(doctype, null);
|
||||
});
|
||||
}, "If the context node is a document with and element child, appending a doctype should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 5.
|
||||
test(function() {
|
||||
var df = document.createDocumentFragment();
|
||||
var a = df.appendChild(document.createElement("a"));
|
||||
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
df.insertBefore(doc, a);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
df.insertBefore(doc, null);
|
||||
});
|
||||
|
||||
var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
df.insertBefore(doctype, a);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
df.insertBefore(doctype, null);
|
||||
});
|
||||
}, "If the context node is a DocumentFragment, inserting a document or a doctype should throw a HierarchyRequestError.")
|
||||
test(function() {
|
||||
var el = document.createElement("div");
|
||||
var a = el.appendChild(document.createElement("a"));
|
||||
|
||||
var doc = document.implementation.createHTMLDocument("title");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
el.insertBefore(doc, a);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
el.insertBefore(doc, null);
|
||||
});
|
||||
|
||||
var doctype = document.implementation.createDocumentType("html", "", "");
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
el.insertBefore(doctype, a);
|
||||
});
|
||||
assert_throws("HierarchyRequestError", function() {
|
||||
el.insertBefore(doctype, null);
|
||||
});
|
||||
}, "If the context node is an element, inserting a document or a doctype should throw a HierarchyRequestError.")
|
||||
|
||||
// Step 7.
|
||||
test(function() {
|
||||
var a = document.createElement("div");
|
||||
var b = document.createElement("div");
|
||||
var c = document.createElement("div");
|
||||
a.appendChild(b);
|
||||
a.appendChild(c);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
assert_equals(a.insertBefore(b, b), b);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
assert_equals(a.insertBefore(c, c), c);
|
||||
assert_array_equals(a.childNodes, [b, c]);
|
||||
}, "Inserting a node before itself should not move the node");
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node-insertBefore.html.orig
|
|
@ -1,66 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<title>Node.removeChild</title>
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<script src="creators.js"></script>
|
||||
<body>
|
||||
<div id="log"></div>
|
||||
</body>
|
||||
<iframe src=about:blank></iframe>
|
||||
<script>
|
||||
|
||||
test(function() {
|
||||
var doc = document;
|
||||
var s = doc.createElement("div");
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a detached Element to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = document;
|
||||
var s = doc.createElement("div");
|
||||
doc.documentElement.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a non-detached Element to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = document;
|
||||
var s = doc.createElement("div");
|
||||
doc.body.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { s.removeChild(doc) })
|
||||
}, "Calling removeChild on an Element with no children should throw NOT_FOUND_ERR.")
|
||||
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("");
|
||||
var s = doc.createElement("div");
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a detached Element to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("");
|
||||
var s = doc.createElement("div");
|
||||
doc.documentElement.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a non-detached Element to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = document.implementation.createHTMLDocument("");
|
||||
var s = doc.createElement("div");
|
||||
doc.body.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { s.removeChild(doc) })
|
||||
}, "Calling removeChild on an Element with no children should throw NOT_FOUND_ERR.")
|
||||
|
||||
test(function() {
|
||||
assert_throws(new TypeError(), function() { document.body.removeChild(null) })
|
||||
//assert_throws(new TypeError(), function() { document.body.removeChild({'a':'b'}) })
|
||||
}, "Passing a value that is not a Node reference to removeChild should throw TypeError.")
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node-removeChild.html
|
|
@ -1,54 +0,0 @@
|
|||
<!DOCTYPE html>
|
||||
<title>Node.removeChild</title>
|
||||
<script src="/resources/testharness.js"></script>
|
||||
<script src="/resources/testharnessreport.js"></script>
|
||||
<script src="creators.js"></script>
|
||||
<div id="log"></div>
|
||||
<iframe src=about:blank></iframe>
|
||||
<script>
|
||||
var documents = [
|
||||
[function() { return document }, "the main document"],
|
||||
[function() { return frames[0].document }, "a frame document"],
|
||||
[function() { return document.implementation.createHTMLDocument() },
|
||||
"a synthetic document"],
|
||||
];
|
||||
|
||||
documents.forEach(function(d) {
|
||||
var get = d[0], description = d[1]
|
||||
for (var p in creators) {
|
||||
var creator = creators[p];
|
||||
test(function() {
|
||||
var doc = get();
|
||||
var s = doc[creator]("a")
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a detached " + p + " from " + description +
|
||||
" to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = get();
|
||||
var s = doc[creator]("b")
|
||||
doc.documentElement.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { document.body.removeChild(s) })
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
}, "Passing a non-detached " + p + " from " + description +
|
||||
" to removeChild should not affect it.")
|
||||
|
||||
test(function() {
|
||||
var doc = get();
|
||||
var s = doc[creator]("test")
|
||||
doc.body.appendChild(s)
|
||||
assert_equals(s.ownerDocument, doc)
|
||||
assert_throws("NOT_FOUND_ERR", function() { s.removeChild(doc) })
|
||||
}, "Calling removeChild on a " + p + " from " + description +
|
||||
" with no children should throw NOT_FOUND_ERR.")
|
||||
}
|
||||
});
|
||||
|
||||
test(function() {
|
||||
assert_throws(new TypeError(), function() { document.body.removeChild(null) })
|
||||
assert_throws(new TypeError(), function() { document.body.removeChild({'a':'b'}) })
|
||||
}, "Passing a value that is not a Node reference to removeChild should throw TypeError.")
|
||||
</script>
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node-removeChild.html.orig
|
|
@ -1,128 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2019 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
(* This file is automatically generated, please do not modify! *)
|
||||
|
||||
section\<open>Testing Node\_insertBefore\<close>
|
||||
text\<open>This theory contains the test cases for Node\_insertBefore.\<close>
|
||||
|
||||
theory Node_insertBefore
|
||||
imports
|
||||
"Core_DOM_BaseTest"
|
||||
begin
|
||||
|
||||
definition Node_insertBefore_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where
|
||||
"Node_insertBefore_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])),
|
||||
(cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 6)] fmempty None)),
|
||||
(cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5)] fmempty None)),
|
||||
(cast (element_ptr.Ref 3), cast (create_element_obj ''title'' [cast (character_data_ptr.Ref 1)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 1), cast (create_character_data_obj ''Node.insertBefore'')),
|
||||
(cast (element_ptr.Ref 4), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharness.js'')]) None)),
|
||||
(cast (element_ptr.Ref 5), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharnessreport.js'')]) None)),
|
||||
(cast (element_ptr.Ref 6), cast (create_element_obj ''body'' [cast (element_ptr.Ref 7), cast (element_ptr.Ref 8)] fmempty None)),
|
||||
(cast (element_ptr.Ref 7), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''log'')]) None)),
|
||||
(cast (element_ptr.Ref 8), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 2)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]"
|
||||
|
||||
definition Node_insertBefore_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Node_insertBefore_document = Some (cast (document_ptr.Ref 1))"
|
||||
|
||||
|
||||
text \<open>"Calling insertBefore an a leaf node Text must throw HIERARCHY\_REQUEST\_ERR."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
node \<leftarrow> Node_insertBefore_document . createTextNode(''Foo'');
|
||||
tmp0 \<leftarrow> Node_insertBefore_document . createTextNode(''fail'');
|
||||
assert_throws(HierarchyRequestError, node . insertBefore(tmp0, None))
|
||||
}) Node_insertBefore_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Calling insertBefore with an inclusive ancestor of the context object must throw HIERARCHY\_REQUEST\_ERR."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
tmp1 \<leftarrow> Node_insertBefore_document . body;
|
||||
tmp2 \<leftarrow> Node_insertBefore_document . getElementById(''log'');
|
||||
tmp0 \<leftarrow> Node_insertBefore_document . body;
|
||||
assert_throws(HierarchyRequestError, tmp0 . insertBefore(tmp1, tmp2));
|
||||
tmp4 \<leftarrow> Node_insertBefore_document . documentElement;
|
||||
tmp5 \<leftarrow> Node_insertBefore_document . getElementById(''log'');
|
||||
tmp3 \<leftarrow> Node_insertBefore_document . body;
|
||||
assert_throws(HierarchyRequestError, tmp3 . insertBefore(tmp4, tmp5))
|
||||
}) Node_insertBefore_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Calling insertBefore with a reference child whose parent is not the context node must throw a NotFoundError."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
a \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
b \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
c \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
assert_throws(NotFoundError, a . insertBefore(b, c))
|
||||
}) Node_insertBefore_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"If the context node is a document, inserting a document or text node should throw a HierarchyRequestError."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> createDocument(''title'');
|
||||
doc2 \<leftarrow> createDocument(''title2'');
|
||||
tmp0 \<leftarrow> doc . documentElement;
|
||||
assert_throws(HierarchyRequestError, doc . insertBefore(doc2, tmp0));
|
||||
tmp1 \<leftarrow> doc . createTextNode(''text'');
|
||||
tmp2 \<leftarrow> doc . documentElement;
|
||||
assert_throws(HierarchyRequestError, doc . insertBefore(tmp1, tmp2))
|
||||
}) Node_insertBefore_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Inserting a node before itself should not move the node"\<close>
|
||||
|
||||
lemma "test (do {
|
||||
a \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
b \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
c \<leftarrow> Node_insertBefore_document . createElement(''div'');
|
||||
a . appendChild(b);
|
||||
a . appendChild(c);
|
||||
tmp0 \<leftarrow> a . childNodes;
|
||||
assert_array_equals(tmp0, [b, c]);
|
||||
tmp1 \<leftarrow> a . insertBefore(b, b);
|
||||
assert_equals(tmp1, b);
|
||||
tmp2 \<leftarrow> a . childNodes;
|
||||
assert_array_equals(tmp2, [b, c]);
|
||||
tmp3 \<leftarrow> a . insertBefore(c, c);
|
||||
assert_equals(tmp3, c);
|
||||
tmp4 \<leftarrow> a . childNodes;
|
||||
assert_array_equals(tmp4, [b, c])
|
||||
}) Node_insertBefore_heap"
|
||||
by eval
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node_insertBefore.thy
|
|
@ -1,159 +0,0 @@
|
|||
(***********************************************************************************
|
||||
* Copyright (c) 2016-2019 The University of Sheffield, UK
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* SPDX-License-Identifier: BSD-2-Clause
|
||||
***********************************************************************************)
|
||||
|
||||
(* This file is automatically generated, please do not modify! *)
|
||||
|
||||
section\<open>Testing Node\_removeChild\<close>
|
||||
text\<open>This theory contains the test cases for Node\_removeChild.\<close>
|
||||
|
||||
theory Node_removeChild
|
||||
imports
|
||||
"Core_DOM_BaseTest"
|
||||
begin
|
||||
|
||||
definition Node_removeChild_heap :: heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l where
|
||||
"Node_removeChild_heap = create_heap [(cast (document_ptr.Ref 1), cast (create_document_obj html (Some (cast (element_ptr.Ref 1))) [])),
|
||||
(cast (element_ptr.Ref 1), cast (create_element_obj ''html'' [cast (element_ptr.Ref 2), cast (element_ptr.Ref 7)] fmempty None)),
|
||||
(cast (element_ptr.Ref 2), cast (create_element_obj ''head'' [cast (element_ptr.Ref 3), cast (element_ptr.Ref 4), cast (element_ptr.Ref 5), cast (element_ptr.Ref 6)] fmempty None)),
|
||||
(cast (element_ptr.Ref 3), cast (create_element_obj ''title'' [cast (character_data_ptr.Ref 1)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 1), cast (create_character_data_obj ''Node.removeChild'')),
|
||||
(cast (element_ptr.Ref 4), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharness.js'')]) None)),
|
||||
(cast (element_ptr.Ref 5), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''/resources/testharnessreport.js'')]) None)),
|
||||
(cast (element_ptr.Ref 6), cast (create_element_obj ''script'' [] (fmap_of_list [(''src'', ''creators.js'')]) None)),
|
||||
(cast (element_ptr.Ref 7), cast (create_element_obj ''body'' [cast (element_ptr.Ref 8), cast (element_ptr.Ref 9), cast (element_ptr.Ref 10)] fmempty None)),
|
||||
(cast (element_ptr.Ref 8), cast (create_element_obj ''div'' [] (fmap_of_list [(''id'', ''log'')]) None)),
|
||||
(cast (element_ptr.Ref 9), cast (create_element_obj ''iframe'' [] (fmap_of_list [(''src'', ''about:blank'')]) None)),
|
||||
(cast (element_ptr.Ref 10), cast (create_element_obj ''script'' [cast (character_data_ptr.Ref 2)] fmempty None)),
|
||||
(cast (character_data_ptr.Ref 2), cast (create_character_data_obj ''%3C%3Cscript%3E%3E''))]"
|
||||
|
||||
definition Node_removeChild_document :: "(unit, unit, unit, unit, unit, unit) object_ptr option" where "Node_removeChild_document = Some (cast (document_ptr.Ref 1))"
|
||||
|
||||
|
||||
text \<open>"Passing a detached Element to removeChild should not affect it."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> return Node_removeChild_document;
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp0, doc);
|
||||
tmp1 \<leftarrow> Node_removeChild_document . body;
|
||||
assert_throws(NotFoundError, tmp1 . removeChild(s));
|
||||
tmp2 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp2, doc)
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Passing a non-detached Element to removeChild should not affect it."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> return Node_removeChild_document;
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> doc . documentElement;
|
||||
tmp0 . appendChild(s);
|
||||
tmp1 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp1, doc);
|
||||
tmp2 \<leftarrow> Node_removeChild_document . body;
|
||||
assert_throws(NotFoundError, tmp2 . removeChild(s));
|
||||
tmp3 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp3, doc)
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Calling removeChild on an Element with no children should throw NOT\_FOUND\_ERR."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> return Node_removeChild_document;
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> doc . body;
|
||||
tmp0 . appendChild(s);
|
||||
tmp1 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp1, doc);
|
||||
assert_throws(NotFoundError, s . removeChild(doc))
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Passing a detached Element to removeChild should not affect it."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> createDocument('''');
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp0, doc);
|
||||
tmp1 \<leftarrow> Node_removeChild_document . body;
|
||||
assert_throws(NotFoundError, tmp1 . removeChild(s));
|
||||
tmp2 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp2, doc)
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Passing a non-detached Element to removeChild should not affect it."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> createDocument('''');
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> doc . documentElement;
|
||||
tmp0 . appendChild(s);
|
||||
tmp1 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp1, doc);
|
||||
tmp2 \<leftarrow> Node_removeChild_document . body;
|
||||
assert_throws(NotFoundError, tmp2 . removeChild(s));
|
||||
tmp3 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp3, doc)
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Calling removeChild on an Element with no children should throw NOT\_FOUND\_ERR."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
doc \<leftarrow> createDocument('''');
|
||||
s \<leftarrow> doc . createElement(''div'');
|
||||
tmp0 \<leftarrow> doc . body;
|
||||
tmp0 . appendChild(s);
|
||||
tmp1 \<leftarrow> s . ownerDocument;
|
||||
assert_equals(tmp1, doc);
|
||||
assert_throws(NotFoundError, s . removeChild(doc))
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
text \<open>"Passing a value that is not a Node reference to removeChild should throw TypeError."\<close>
|
||||
|
||||
lemma "test (do {
|
||||
tmp0 \<leftarrow> Node_removeChild_document . body;
|
||||
assert_throws(TypeError, tmp0 . removeChild(None))
|
||||
}) Node_removeChild_heap"
|
||||
by eval
|
||||
|
||||
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
../../../Core_DOM/common/tests/Node_removeChild.thy
|
Reference in New Issue