@@ -1,7 +1,7 @@ | |||
chapter AFP | |||
session "Core_DOM-devel" (AFP) = "HOL-Library" + | |||
options [timeout = 1200] | |||
options [timeout = 2400] | |||
directories | |||
"common" | |||
"common/classes" | |||
@@ -15,6 +15,6 @@ session "Core_DOM-devel" (AFP) = "HOL-Library" + | |||
theories | |||
Core_DOM | |||
Core_DOM_Tests | |||
document_files (in "document") | |||
document_files | |||
"root.tex" | |||
"root.bib" |
@@ -216,7 +216,7 @@ lemma get_child_nodes_reads: "reads (get_child_nodes_locs ptr) (get_child_nodes | |||
intro!: reads_bind_pure reads_subset[OF return_reads] )[1] | |||
apply(auto simp add: get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: reads_subset[OF reads_singleton] | |||
reads_subset[OF check_in_heap_reads] intro!: reads_bind_pure reads_subset[OF return_reads] | |||
split: option.splits) | |||
split: option.splits)[1] | |||
done | |||
end | |||
@@ -618,7 +618,8 @@ lemma set_child_nodes_get_child_nodes_different_pointers: | |||
apply(auto)[1] | |||
apply(auto)[1] | |||
apply(rule is_element_ptr_kind_obtains) | |||
apply(auto) | |||
apply(auto)[1] | |||
apply(auto)[1] | |||
done | |||
lemma set_child_nodes_element_ok [simp]: | |||
@@ -630,10 +631,12 @@ lemma set_child_nodes_element_ok [simp]: | |||
proof - | |||
have "is_element_ptr ptr" | |||
using \<open>known_ptr ptr\<close> assms(4) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs | |||
ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
then show ?thesis | |||
using assms | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def | |||
split: option.splits)[1] | |||
by (simp add: DocumentMonad.put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok local.type_wf_impl) | |||
qed | |||
@@ -647,10 +650,12 @@ lemma set_child_nodes_document1_ok [simp]: | |||
proof - | |||
have "is_document_ptr ptr" | |||
using \<open>known_ptr ptr\<close> assms(4) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs | |||
ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
then show ?thesis | |||
using assms | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def | |||
split: option.splits)[1] | |||
by (simp add: DocumentMonad.put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok local.type_wf_impl) | |||
qed | |||
@@ -665,10 +670,11 @@ lemma set_child_nodes_document2_ok [simp]: | |||
proof - | |||
have "is_document_ptr ptr" | |||
using \<open>known_ptr ptr\<close> assms(4) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
by(auto simp add: known_ptr_impl known_ptr_defs CharacterDataClass.known_ptr_defs | |||
ElementClass.known_ptr_defs NodeClass.known_ptr_defs split: option.splits) | |||
then show ?thesis | |||
using assms | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def) | |||
apply(auto simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def)[1] | |||
apply(split invoke_splits, rule conjI)+ | |||
apply(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] | |||
apply(auto simp add: is_element_ptr_kind\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def set_child_nodes\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)[1] | |||
@@ -1172,7 +1178,8 @@ begin | |||
definition a_set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> (_, unit) dom_prog" | |||
where | |||
"a_set_disconnected_nodes document_ptr disc_nodes = put_M document_ptr disconnected_nodes_update disc_nodes" | |||
"a_set_disconnected_nodes document_ptr disc_nodes = | |||
put_M document_ptr disconnected_nodes_update disc_nodes" | |||
lemmas set_disconnected_nodes_defs = a_set_disconnected_nodes_def | |||
definition a_set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
@@ -1196,10 +1203,13 @@ locale l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\ | |||
assumes set_disconnected_nodes_locs_impl: "set_disconnected_nodes_locs = a_set_disconnected_nodes_locs" | |||
begin | |||
lemmas set_disconnected_nodes_def = set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def] | |||
lemmas set_disconnected_nodes_locs_def = set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] | |||
lemmas set_disconnected_nodes_locs_def = | |||
set_disconnected_nodes_locs_impl[unfolded a_set_disconnected_nodes_locs_def] | |||
lemma set_disconnected_nodes_ok: | |||
"type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_disconnected_nodes document_ptr node_ptrs)" | |||
by (simp add: type_wf_impl put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def]) | |||
"type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow> | |||
h \<turnstile> ok (set_disconnected_nodes document_ptr node_ptrs)" | |||
by (simp add: type_wf_impl put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok | |||
set_disconnected_nodes_impl[unfolded a_set_disconnected_nodes_def]) | |||
lemma set_disconnected_nodes_ptr_in_heap: | |||
"h \<turnstile> ok (set_disconnected_nodes document_ptr disc_nodes) \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h" | |||
@@ -1234,13 +1244,17 @@ end | |||
locale l_set_disconnected_nodes = l_type_wf + l_set_disconnected_nodes_defs + | |||
assumes set_disconnected_nodes_writes: | |||
"writes (set_disconnected_nodes_locs document_ptr) (set_disconnected_nodes document_ptr disc_nodes) h h'" | |||
"writes (set_disconnected_nodes_locs document_ptr) | |||
(set_disconnected_nodes document_ptr disc_nodes) h h'" | |||
assumes set_disconnected_nodes_ok: | |||
"type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_disconnected_nodes document_ptr disc_noded)" | |||
"type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow> | |||
h \<turnstile> ok (set_disconnected_nodes document_ptr disc_noded)" | |||
assumes set_disconnected_nodes_ptr_in_heap: | |||
"h \<turnstile> ok (set_disconnected_nodes document_ptr disc_noded) \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h" | |||
"h \<turnstile> ok (set_disconnected_nodes document_ptr disc_noded) \<Longrightarrow> | |||
document_ptr |\<in>| document_ptr_kinds h" | |||
assumes set_disconnected_nodes_pointers_preserved: | |||
"w \<in> set_disconnected_nodes_locs document_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'" | |||
"w \<in> set_disconnected_nodes_locs document_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> | |||
object_ptr_kinds h = object_ptr_kinds h'" | |||
assumes set_disconnected_nodes_types_preserved: | |||
"w \<in> set_disconnected_nodes_locs document_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'" | |||
@@ -1257,7 +1271,8 @@ declare l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D | |||
lemma set_disconnected_nodes_is_l_set_disconnected_nodes [instances]: | |||
"l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs" | |||
apply(simp add: l_set_disconnected_nodes_def) | |||
using set_disconnected_nodes_ok set_disconnected_nodes_writes set_disconnected_nodes_pointers_preserved | |||
using set_disconnected_nodes_ok set_disconnected_nodes_writes | |||
set_disconnected_nodes_pointers_preserved | |||
set_disconnected_nodes_ptr_in_heap set_disconnected_nodes_typess_preserved | |||
by blast+ | |||
@@ -1299,7 +1314,8 @@ interpretation i_set_disconnected_nodes_get_disconnected_nodes?: | |||
by unfold_locales | |||
declare l_set_disconnected_nodes_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_disconnected_nodes_get_disconnected_nodes_is_l_set_disconnected_nodes_get_disconnected_nodes [instances]: | |||
lemma set_disconnected_nodes_get_disconnected_nodes_is_l_set_disconnected_nodes_get_disconnected_nodes | |||
[instances]: | |||
"l_set_disconnected_nodes_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs | |||
set_disconnected_nodes set_disconnected_nodes_locs" | |||
using set_disconnected_nodes_is_l_set_disconnected_nodes get_disconnected_nodes_is_l_get_disconnected_nodes | |||
@@ -1346,17 +1362,17 @@ subsubsection \<open>get\_tag\_name\<close> | |||
locale l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
begin | |||
definition a_get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_type) dom_prog" | |||
definition a_get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_name) dom_prog" | |||
where | |||
"a_get_tag_name element_ptr = get_M element_ptr tag_type" | |||
"a_get_tag_name element_ptr = get_M element_ptr tag_name" | |||
definition a_get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" | |||
where | |||
"a_get_tag_name_locs element_ptr \<equiv> {preserved (get_M element_ptr tag_type)}" | |||
"a_get_tag_name_locs element_ptr \<equiv> {preserved (get_M element_ptr tag_name)}" | |||
end | |||
locale l_get_tag_name_defs = | |||
fixes get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_type) dom_prog" | |||
fixes get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_name) dom_prog" | |||
fixes get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" | |||
locale l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
@@ -1364,7 +1380,7 @@ locale l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^ | |||
l_get_tag_name_defs get_tag_name get_tag_name_locs + | |||
l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
for type_wf :: "(_) heap \<Rightarrow> bool" | |||
and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_type) dom_prog" | |||
and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_name) dom_prog" | |||
and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" + | |||
assumes type_wf_impl: "type_wf = DocumentClass.type_wf" | |||
assumes get_tag_name_impl: "get_tag_name = a_get_tag_name" | |||
@@ -1466,7 +1482,7 @@ begin | |||
lemma set_child_nodes_get_tag_name: | |||
"\<forall>w \<in> set_child_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))" | |||
by(auto simp add: set_child_nodes_locs_def get_tag_name_locs_def all_args_def | |||
intro: element_put_get_preserved[where getter=tag_type and setter=child_nodes_update]) | |||
intro: element_put_get_preserved[where getter=tag_name and setter=child_nodes_update]) | |||
end | |||
locale l_set_child_nodes_get_tag_name = l_set_child_nodes + l_get_tag_name + | |||
@@ -1489,162 +1505,207 @@ lemma set_child_nodes_get_tag_name_is_l_set_child_nodes_get_tag_name [instances] | |||
subsubsection \<open>set\_tag\_type\<close> | |||
locale l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
locale l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
begin | |||
definition a_set_tag_type :: "(_) element_ptr \<Rightarrow> tag_type \<Rightarrow> (_, unit) dom_prog" | |||
definition a_set_tag_name :: "(_) element_ptr \<Rightarrow> tag_name \<Rightarrow> (_, unit) dom_prog" | |||
where | |||
"a_set_tag_type ptr tag = do { | |||
"a_set_tag_name ptr tag = do { | |||
m \<leftarrow> get_M ptr attrs; | |||
put_M ptr tag_type_update tag | |||
put_M ptr tag_name_update tag | |||
}" | |||
lemmas set_tag_type_defs = a_set_tag_type_def | |||
lemmas set_tag_name_defs = a_set_tag_name_def | |||
definition a_set_tag_type_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
definition a_set_tag_name_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
where | |||
"a_set_tag_type_locs element_ptr \<equiv> all_args (put_M element_ptr tag_type_update)" | |||
"a_set_tag_name_locs element_ptr \<equiv> all_args (put_M element_ptr tag_name_update)" | |||
end | |||
locale l_set_tag_type_defs = | |||
fixes set_tag_type :: "(_) element_ptr \<Rightarrow> tag_type \<Rightarrow> (_, unit) dom_prog" | |||
fixes set_tag_type_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
locale l_set_tag_name_defs = | |||
fixes set_tag_name :: "(_) element_ptr \<Rightarrow> tag_name \<Rightarrow> (_, unit) dom_prog" | |||
fixes set_tag_name_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
locale l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
locale l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_type_wf type_wf + | |||
l_set_tag_type_defs set_tag_type set_tag_type_locs + | |||
l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
l_set_tag_name_defs set_tag_name set_tag_name_locs + | |||
l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
for type_wf :: "(_) heap \<Rightarrow> bool" | |||
and set_tag_type :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> (_, unit) dom_prog" | |||
and set_tag_type_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" + | |||
and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> (_, unit) dom_prog" | |||
and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" + | |||
assumes type_wf_impl: "type_wf = DocumentClass.type_wf" | |||
assumes set_tag_type_impl: "set_tag_type = a_set_tag_type" | |||
assumes set_tag_type_locs_impl: "set_tag_type_locs = a_set_tag_type_locs" | |||
assumes set_tag_name_impl: "set_tag_name = a_set_tag_name" | |||
assumes set_tag_name_locs_impl: "set_tag_name_locs = a_set_tag_name_locs" | |||
begin | |||
lemma set_tag_type_ok: | |||
"type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_tag_type element_ptr tag)" | |||
lemma set_tag_name_ok: | |||
"type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_tag_name element_ptr tag)" | |||
apply(unfold type_wf_impl) | |||
unfolding set_tag_type_impl[unfolded a_set_tag_type_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok | |||
unfolding set_tag_name_impl[unfolded a_set_tag_name_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok | |||
by (metis (no_types, lifting) DocumentClass.type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t ElementMonad.get_M_pure bind_is_OK_E | |||
bind_is_OK_pure_I is_OK_returns_result_I) | |||
lemma set_tag_type_writes: | |||
"writes (set_tag_type_locs element_ptr) (set_tag_type element_ptr tag) h h'" | |||
by(auto simp add: set_tag_type_impl[unfolded a_set_tag_type_def] | |||
set_tag_type_locs_impl[unfolded a_set_tag_type_locs_def] intro: writes_bind_pure) | |||
lemma set_tag_name_writes: | |||
"writes (set_tag_name_locs element_ptr) (set_tag_name element_ptr tag) h h'" | |||
by(auto simp add: set_tag_name_impl[unfolded a_set_tag_name_def] | |||
set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] intro: writes_bind_pure) | |||
lemma set_tag_type_pointers_preserved: | |||
assumes "w \<in> set_tag_type_locs element_ptr" | |||
lemma set_tag_name_pointers_preserved: | |||
assumes "w \<in> set_tag_name_locs element_ptr" | |||
assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'" | |||
shows "object_ptr_kinds h = object_ptr_kinds h'" | |||
using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)] | |||
by(auto simp add: all_args_def set_tag_type_locs_impl[unfolded a_set_tag_type_locs_def] | |||
by(auto simp add: all_args_def set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] | |||
split: if_splits) | |||
lemma set_tag_type_typess_preserved: | |||
assumes "w \<in> set_tag_type_locs element_ptr" | |||
lemma set_tag_name_typess_preserved: | |||
assumes "w \<in> set_tag_name_locs element_ptr" | |||
assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'" | |||
shows "type_wf h = type_wf h'" | |||
apply(unfold type_wf_impl) | |||
using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)] | |||
by(auto simp add: all_args_def set_tag_type_locs_impl[unfolded a_set_tag_type_locs_def] | |||
by(auto simp add: all_args_def set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] | |||
split: if_splits) | |||
end | |||
locale l_set_tag_type = l_type_wf + l_set_tag_type_defs + | |||
assumes set_tag_type_writes: | |||
"writes (set_tag_type_locs element_ptr) (set_tag_type element_ptr tag) h h'" | |||
assumes set_tag_type_ok: | |||
"type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_tag_type element_ptr tag)" | |||
assumes set_tag_type_pointers_preserved: | |||
"w \<in> set_tag_type_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'" | |||
assumes set_tag_type_types_preserved: | |||
"w \<in> set_tag_type_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'" | |||
locale l_set_tag_name = l_type_wf + l_set_tag_name_defs + | |||
assumes set_tag_name_writes: | |||
"writes (set_tag_name_locs element_ptr) (set_tag_name element_ptr tag) h h'" | |||
assumes set_tag_name_ok: | |||
"type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_tag_name element_ptr tag)" | |||
assumes set_tag_name_pointers_preserved: | |||
"w \<in> set_tag_name_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'" | |||
assumes set_tag_name_types_preserved: | |||
"w \<in> set_tag_name_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'" | |||
global_interpretation l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines | |||
set_tag_type = l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_type and | |||
set_tag_type_locs = l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_type_locs . | |||
global_interpretation l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines | |||
set_tag_name = l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_name and | |||
set_tag_name_locs = l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_tag_name_locs . | |||
interpretation | |||
i_set_tag_type?: l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_tag_type set_tag_type_locs | |||
i_set_tag_name?: l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_tag_name set_tag_name_locs | |||
apply(unfold_locales) | |||
by (auto simp add: set_tag_type_def set_tag_type_locs_def) | |||
declare l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_tag_type_is_l_set_tag_type [instances]: | |||
"l_set_tag_type type_wf set_tag_type set_tag_type_locs" | |||
apply(simp add: l_set_tag_type_def) | |||
using set_tag_type_ok set_tag_type_writes set_tag_type_pointers_preserved | |||
set_tag_type_typess_preserved | |||
by (auto simp add: set_tag_name_def set_tag_name_locs_def) | |||
declare l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_tag_name_is_l_set_tag_name [instances]: | |||
"l_set_tag_name type_wf set_tag_name set_tag_name_locs" | |||
apply(simp add: l_set_tag_name_def) | |||
using set_tag_name_ok set_tag_name_writes set_tag_name_pointers_preserved | |||
set_tag_name_typess_preserved | |||
by blast | |||
paragraph \<open>get\_child\_nodes\<close> | |||
locale l_set_tag_type_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + | |||
locale l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + | |||
l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M | |||
begin | |||
lemma set_tag_type_get_child_nodes: | |||
"\<forall>w \<in> set_tag_type_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))" | |||
by(auto simp add: set_tag_type_locs_impl[unfolded a_set_tag_type_locs_def] | |||
lemma set_tag_name_get_child_nodes: | |||
"\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))" | |||
by(auto simp add: set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] | |||
get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def] all_args_def | |||
intro: element_put_get_preserved[where setter=tag_type_update and getter=child_nodes]) | |||
intro: element_put_get_preserved[where setter=tag_name_update and getter=child_nodes]) | |||
end | |||
locale l_set_tag_type_get_child_nodes = l_set_tag_type + l_get_child_nodes + | |||
assumes set_tag_type_get_child_nodes: | |||
"\<forall>w \<in> set_tag_type_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))" | |||
locale l_set_tag_name_get_child_nodes = l_set_tag_name + l_get_child_nodes + | |||
assumes set_tag_name_get_child_nodes: | |||
"\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))" | |||
interpretation | |||
i_set_tag_type_get_child_nodes?: l_set_tag_type_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf | |||
set_tag_type set_tag_type_locs known_ptr | |||
i_set_tag_name_get_child_nodes?: l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf | |||
set_tag_name set_tag_name_locs known_ptr | |||
get_child_nodes get_child_nodes_locs | |||
by unfold_locales | |||
declare l_set_tag_type_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
declare l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_tag_type_get_child_nodes_is_l_set_tag_type_get_child_nodes [instances]: | |||
"l_set_tag_type_get_child_nodes type_wf set_tag_type set_tag_type_locs known_ptr get_child_nodes | |||
lemma set_tag_name_get_child_nodes_is_l_set_tag_name_get_child_nodes [instances]: | |||
"l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr get_child_nodes | |||
get_child_nodes_locs" | |||
using set_tag_type_is_l_set_tag_type get_child_nodes_is_l_get_child_nodes | |||
apply(simp add: l_set_tag_type_get_child_nodes_def l_set_tag_type_get_child_nodes_axioms_def) | |||
using set_tag_type_get_child_nodes | |||
using set_tag_name_is_l_set_tag_name get_child_nodes_is_l_get_child_nodes | |||
apply(simp add: l_set_tag_name_get_child_nodes_def l_set_tag_name_get_child_nodes_axioms_def) | |||
using set_tag_name_get_child_nodes | |||
by fast | |||
paragraph \<open>get\_disconnected\_nodes\<close> | |||
locale l_set_tag_type_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_set_tag_type\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + | |||
locale l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M + | |||
l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M | |||
begin | |||
lemma set_tag_type_get_disconnected_nodes: | |||
"\<forall>w \<in> set_tag_type_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))" | |||
by(auto simp add: set_tag_type_locs_impl[unfolded a_set_tag_type_locs_def] | |||
lemma set_tag_name_get_disconnected_nodes: | |||
"\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))" | |||
by(auto simp add: set_tag_name_locs_impl[unfolded a_set_tag_name_locs_def] | |||
get_disconnected_nodes_locs_impl[unfolded a_get_disconnected_nodes_locs_def] | |||
all_args_def) | |||
end | |||
locale l_set_tag_type_get_disconnected_nodes = l_set_tag_type + l_get_disconnected_nodes + | |||
assumes set_tag_type_get_disconnected_nodes: | |||
"\<forall>w \<in> set_tag_type_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))" | |||
locale l_set_tag_name_get_disconnected_nodes = l_set_tag_name + l_get_disconnected_nodes + | |||
assumes set_tag_name_get_disconnected_nodes: | |||
"\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))" | |||
interpretation | |||
i_set_tag_type_get_disconnected_nodes?: l_set_tag_type_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf | |||
set_tag_type set_tag_type_locs get_disconnected_nodes | |||
i_set_tag_name_get_disconnected_nodes?: l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf | |||
set_tag_name set_tag_name_locs get_disconnected_nodes | |||
get_disconnected_nodes_locs | |||
by unfold_locales | |||
declare l_set_tag_type_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
declare l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_tag_type_get_disconnected_nodes_is_l_set_tag_type_get_disconnected_nodes [instances]: | |||
"l_set_tag_type_get_disconnected_nodes type_wf set_tag_type set_tag_type_locs get_disconnected_nodes | |||
lemma set_tag_name_get_disconnected_nodes_is_l_set_tag_name_get_disconnected_nodes [instances]: | |||
"l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs get_disconnected_nodes | |||
get_disconnected_nodes_locs" | |||
using set_tag_type_is_l_set_tag_type get_disconnected_nodes_is_l_get_disconnected_nodes | |||
apply(simp add: l_set_tag_type_get_disconnected_nodes_def | |||
l_set_tag_type_get_disconnected_nodes_axioms_def) | |||
using set_tag_type_get_disconnected_nodes | |||
using set_tag_name_is_l_set_tag_name get_disconnected_nodes_is_l_get_disconnected_nodes | |||
apply(simp add: l_set_tag_name_get_disconnected_nodes_def | |||
l_set_tag_name_get_disconnected_nodes_axioms_def) | |||
using set_tag_name_get_disconnected_nodes | |||
by fast | |||
paragraph \<open>get\_tag\_type\<close> | |||
locale l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M | |||
+ l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M | |||
begin | |||
lemma set_tag_name_get_tag_name: | |||
assumes "h \<turnstile> a_set_tag_name element_ptr tag \<rightarrow>\<^sub>h h'" | |||
shows "h' \<turnstile> a_get_tag_name element_ptr \<rightarrow>\<^sub>r tag" | |||
using assms | |||
by(auto simp add: a_get_tag_name_def a_set_tag_name_def) | |||
lemma set_tag_name_get_tag_name_different_pointers: | |||
assumes "ptr \<noteq> ptr'" | |||
assumes "w \<in> a_set_tag_name_locs ptr" | |||
assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'" | |||
assumes "r \<in> a_get_tag_name_locs ptr'" | |||
shows "r h h'" | |||
using assms | |||
by(auto simp add: all_args_def a_set_tag_name_locs_def a_get_tag_name_locs_def | |||
split: if_splits option.splits ) | |||
end | |||
locale l_set_tag_name_get_tag_name = l_get_tag_name + l_set_tag_name + | |||
assumes set_tag_name_get_tag_name: | |||
"h \<turnstile> set_tag_name element_ptr tag \<rightarrow>\<^sub>h h' | |||
\<Longrightarrow> h' \<turnstile> get_tag_name element_ptr \<rightarrow>\<^sub>r tag" | |||
assumes set_tag_name_get_tag_name_different_pointers: | |||
"ptr \<noteq> ptr' \<Longrightarrow> w \<in> set_tag_name_locs ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' | |||
\<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'" | |||
interpretation i_set_tag_name_get_tag_name?: | |||
l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_tag_name | |||
get_tag_name_locs set_tag_name set_tag_name_locs | |||
by unfold_locales | |||
declare l_set_tag_name_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_tag_name_get_tag_name_is_l_set_tag_name_get_tag_name [instances]: | |||
"l_set_tag_name_get_tag_name type_wf get_tag_name get_tag_name_locs | |||
set_tag_name set_tag_name_locs" | |||
using set_tag_name_is_l_set_tag_name get_tag_name_is_l_get_tag_name | |||
apply(simp add: l_set_tag_name_get_tag_name_def | |||
l_set_tag_name_get_tag_name_axioms_def) | |||
using set_tag_name_get_tag_name | |||
set_tag_name_get_tag_name_different_pointers | |||
by fast+ | |||
subsubsection \<open>set\_val\<close> | |||
locale l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs | |||
@@ -1785,7 +1846,8 @@ interpretation | |||
declare l_set_val_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
lemma set_val_get_disconnected_nodes_is_l_set_val_get_disconnected_nodes [instances]: | |||
"l_set_val_get_disconnected_nodes type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs" | |||
"l_set_val_get_disconnected_nodes type_wf set_val set_val_locs get_disconnected_nodes | |||
get_disconnected_nodes_locs" | |||
using set_val_is_l_set_val get_disconnected_nodes_is_l_get_disconnected_nodes | |||
apply(simp add: l_set_val_get_disconnected_nodes_def l_set_val_get_disconnected_nodes_axioms_def) | |||
using set_val_get_disconnected_nodes | |||
@@ -2419,7 +2481,9 @@ lemma remove_child_child_in_heap: | |||
assumes "h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'" | |||
shows "child |\<in>| node_ptr_kinds h" | |||
using assms | |||
apply(auto simp add: remove_child_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] split: if_splits)[1] | |||
apply(auto simp add: remove_child_def | |||
elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated] | |||
split: if_splits)[1] | |||
by (meson is_OK_returns_result_I local.get_owner_document_ptr_in_heap node_ptr_kinds_commutes) | |||
@@ -2437,7 +2501,8 @@ proof - | |||
using assms(1) | |||
apply(auto simp add: remove_child_def | |||
elim!: bind_returns_heap_E | |||
dest!: returns_result_eq[OF assms(2)] pure_returns_heap_eq[rotated, OF get_owner_document_pure] | |||
dest!: returns_result_eq[OF assms(2)] | |||
pure_returns_heap_eq[rotated, OF get_owner_document_pure] | |||
pure_returns_heap_eq[rotated, OF get_child_nodes_pure] | |||
split: if_splits)[1] | |||
by (metis get_disconnected_nodes_pure pure_returns_heap_eq) | |||
@@ -2460,7 +2525,8 @@ lemma remove_child_writes [simp]: | |||
intro!: writes_bind) | |||
lemma remove_writes: | |||
"writes (remove_child_locs (the |h \<turnstile> get_parent child|\<^sub>r) |h \<turnstile> get_owner_document (cast child)|\<^sub>r) (remove child) h h'" | |||
"writes (remove_child_locs (the |h \<turnstile> get_parent child|\<^sub>r) |h \<turnstile> get_owner_document (cast child)|\<^sub>r) | |||
(remove child) h h'" | |||
by(auto simp add: remove_def intro!: writes_bind_pure split: option.splits) | |||
lemma remove_child_children_subset: | |||
@@ -2544,7 +2610,8 @@ end | |||
locale l_remove_child = l_type_wf + l_known_ptrs + l_remove_child_defs + l_get_owner_document_defs | |||
+ l_get_child_nodes_defs + l_get_disconnected_nodes_defs + | |||
assumes remove_child_writes: | |||
"writes (remove_child_locs object_ptr |h \<turnstile> get_owner_document (cast child)|\<^sub>r) (remove_child object_ptr child) h h'" | |||
"writes (remove_child_locs object_ptr |h \<turnstile> get_owner_document (cast child)|\<^sub>r) | |||
(remove_child object_ptr child) h h'" | |||
assumes remove_child_pointers_preserved: | |||
"w \<in> remove_child_locs ptr owner_document \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'" | |||
assumes remove_child_types_preserved: | |||
@@ -2742,7 +2809,8 @@ proof - | |||
obtain old_document parent_opt h2 where | |||
old_document: "h \<turnstile> get_owner_document (cast node) \<rightarrow>\<^sub>r old_document" and | |||
parent_opt: "h \<turnstile> get_parent node \<rightarrow>\<^sub>r parent_opt" and | |||
h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node } | None \<Rightarrow> do { return ()}) \<rightarrow>\<^sub>h h2" | |||
h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> do { remove_child parent node } | | |||
None \<Rightarrow> do { return ()}) \<rightarrow>\<^sub>h h2" | |||
and | |||
h': "h2 \<turnstile> (if owner_document \<noteq> old_document then do { | |||
old_disc_nodes \<leftarrow> get_disconnected_nodes old_document; | |||
@@ -2790,7 +2858,8 @@ proof - | |||
next | |||
case (Some option) | |||
then show ?case | |||
using assms(2) \<open>h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'\<close> remove_child_children_subset known_ptrs type_wf | |||
using assms(2) \<open>h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children'\<close> remove_child_children_subset known_ptrs | |||
type_wf | |||
by simp | |||
qed | |||
qed | |||
@@ -2824,7 +2893,8 @@ lemma adopt_node_types_preserved: | |||
by (auto split: if_splits) | |||
end | |||
locale l_adopt_node = l_type_wf + l_known_ptrs + l_get_parent_defs + l_adopt_node_defs + l_get_child_nodes_defs + l_get_owner_document_defs + | |||
locale l_adopt_node = l_type_wf + l_known_ptrs + l_get_parent_defs + l_adopt_node_defs + | |||
l_get_child_nodes_defs + l_get_owner_document_defs + | |||
assumes adopt_node_writes: | |||
"writes (adopt_node_locs |h \<turnstile> get_parent node|\<^sub>r | |||
|h \<turnstile> get_owner_document (cast node)|\<^sub>r document_ptr) (adopt_node document_ptr node) h h'" | |||
@@ -3020,7 +3090,8 @@ locale l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\< | |||
and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog" | |||
and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" | |||
and get_owner_document :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog" | |||
and insert_before :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> (_) node_ptr option \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and insert_before :: | |||
"(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> (_) node_ptr option \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and insert_before_locs :: "(_) object_ptr \<Rightarrow> (_) object_ptr option \<Rightarrow> (_) document_ptr | |||
\<Rightarrow> (_) document_ptr \<Rightarrow> (_, unit) dom_prog set" | |||
and append_child :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog" | |||
@@ -3084,7 +3155,8 @@ lemma insert_before_ptr_in_heap: | |||
shows "ptr |\<in>| object_ptr_kinds h" | |||
using assms | |||
apply(auto simp add: insert_before_def elim!: bind_is_OK_E)[1] | |||
by (metis (mono_tags, lifting) ensure_pre_insertion_validity_pure is_OK_returns_result_I local.get_owner_document_ptr_in_heap next_sibling_pure pure_returns_heap_eq return_returns_heap) | |||
by (metis (mono_tags, lifting) ensure_pre_insertion_validity_pure is_OK_returns_result_I | |||
local.get_owner_document_ptr_in_heap next_sibling_pure pure_returns_heap_eq return_returns_heap) | |||
lemma insert_before_child_in_heap: | |||
assumes "h \<turnstile> ok (insert_before ptr node reference_child)" | |||
@@ -3203,7 +3275,7 @@ subsubsection \<open>create\_element\<close> | |||
locale l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs = | |||
l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs + | |||
l_set_disconnected_nodes_defs set_disconnected_nodes set_disconnected_nodes_locs + | |||
l_set_tag_type_defs set_tag_type set_tag_type_locs | |||
l_set_tag_name_defs set_tag_name set_tag_name_locs | |||
for get_disconnected_nodes :: | |||
"(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog" | |||
and get_disconnected_nodes_locs :: | |||
@@ -3212,16 +3284,16 @@ locale l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ | |||
"(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and set_disconnected_nodes_locs :: | |||
"(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" | |||
and set_tag_type :: | |||
and set_tag_name :: | |||
"(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and set_tag_type_locs :: | |||
and set_tag_name_locs :: | |||
"(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" | |||
begin | |||
definition a_create_element :: "(_) document_ptr \<Rightarrow> tag_type \<Rightarrow> (_, (_) element_ptr) dom_prog" | |||
definition a_create_element :: "(_) document_ptr \<Rightarrow> tag_name \<Rightarrow> (_, (_) element_ptr) dom_prog" | |||
where | |||
"a_create_element document_ptr tag = do { | |||
new_element_ptr \<leftarrow> new_element; | |||
set_tag_type new_element_ptr tag; | |||
set_tag_name new_element_ptr tag; | |||
disc_nodes \<leftarrow> get_disconnected_nodes document_ptr; | |||
set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes); | |||
return new_element_ptr | |||
@@ -3229,28 +3301,29 @@ definition a_create_element :: "(_) document_ptr \<Rightarrow> tag_type \<Righta | |||
end | |||
locale l_create_element_defs = | |||
fixes create_element :: "(_) document_ptr \<Rightarrow> tag_type \<Rightarrow> (_, (_) element_ptr) dom_prog" | |||
fixes create_element :: "(_) document_ptr \<Rightarrow> tag_name \<Rightarrow> (_, (_) element_ptr) dom_prog" | |||
global_interpretation l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_disconnected_nodes get_disconnected_nodes_locs | |||
set_disconnected_nodes set_disconnected_nodes_locs | |||
set_tag_type set_tag_type_locs | |||
set_tag_name set_tag_name_locs | |||
defines | |||
create_element = "l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_create_element get_disconnected_nodes | |||
set_disconnected_nodes set_tag_type" | |||
set_disconnected_nodes set_tag_name" | |||
. | |||
locale l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_type set_tag_type_locs + | |||
l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_disconnected_nodes get_disconnected_nodes_locs | |||
set_disconnected_nodes set_disconnected_nodes_locs set_tag_name set_tag_name_locs + | |||
l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + | |||
l_set_tag_type type_wf set_tag_type set_tag_type_locs + | |||
l_set_tag_name type_wf set_tag_name set_tag_name_locs + | |||
l_create_element_defs create_element + | |||
l_known_ptr known_ptr | |||
for get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog" | |||
and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" | |||
and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" | |||
and set_tag_type :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and set_tag_type_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" | |||
and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog" | |||
and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" | |||
and type_wf :: "(_) heap \<Rightarrow> bool" | |||
and create_element :: "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog" | |||
and known_ptr :: "(_) object_ptr \<Rightarrow> bool" + | |||
@@ -3270,7 +3343,7 @@ proof - | |||
obtain new_element_ptr h2 h3 disc_nodes_h3 where | |||
new_element_ptr: "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr" and | |||
h2: "h \<turnstile> new_element \<rightarrow>\<^sub>h h2" and | |||
h3: "h2 \<turnstile> set_tag_type new_element_ptr tag \<rightarrow>\<^sub>h h3" and | |||
h3: "h2 \<turnstile> set_tag_name new_element_ptr tag \<rightarrow>\<^sub>h h3" and | |||
disc_nodes_h3: "h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3" and | |||
h': "h3 \<turnstile> set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes_h3) \<rightarrow>\<^sub>h h'" | |||
by(auto simp add: create_element_def | |||
@@ -3281,8 +3354,9 @@ proof - | |||
using new_element_new_ptr h2 new_element_ptr by blast | |||
moreover have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" | |||
apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h", OF set_tag_type_writes h3]) | |||
using set_tag_type_pointers_preserved | |||
apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h", | |||
OF set_tag_name_writes h3]) | |||
using set_tag_name_pointers_preserved | |||
by (auto simp add: reflp_def transp_def) | |||
moreover have "document_ptr |\<in>| document_ptr_kinds h3" | |||
by (meson disc_nodes_h3 is_OK_returns_result_I local.get_disconnected_nodes_ptr_in_heap) | |||
@@ -3301,14 +3375,17 @@ proof - | |||
using new_element_is_element_ptr | |||
by blast | |||
then show ?thesis | |||
by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs) | |||
by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs | |||
ElementClass.known_ptr_defs) | |||
qed | |||
end | |||
locale l_create_element = l_create_element_defs | |||
interpretation | |||
i_create_element?: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_type set_tag_type_locs type_wf create_element known_ptr | |||
i_create_element?: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs | |||
set_disconnected_nodes set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf | |||
create_element known_ptr | |||
by(auto simp add: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def create_element_def instances) | |||
declare l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances] | |||
@@ -3347,7 +3424,8 @@ global_interpretation l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^ | |||
. | |||
locale l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = | |||
l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + | |||
l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs set_val set_val_locs get_disconnected_nodes | |||
get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs + | |||
l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs + | |||
l_set_val type_wf set_val set_val_locs + | |||
l_create_character_data_defs create_character_data + | |||
@@ -3388,7 +3466,8 @@ proof - | |||
using new_character_data_new_ptr h2 new_character_data_ptr by blast | |||
moreover have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2" | |||
apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h", OF set_val_writes h3]) | |||
apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h", | |||
OF set_val_writes h3]) | |||
using set_val_pointers_preserved | |||
by (auto simp add: reflp_def transp_def) | |||
moreover have "document_ptr |\<in>| document_ptr_kinds h3" | |||
@@ -3408,15 +3487,19 @@ proof - | |||
using new_character_data_is_character_data_ptr | |||
by blast | |||
then show ?thesis | |||
by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs) | |||
by(auto simp add: known_ptr_impl DocumentClass.known_ptr_defs CharacterDataClass.known_ptr_defs | |||
ElementClass.known_ptr_defs) | |||
qed | |||
end | |||
locale l_create_character_data = l_create_character_data_defs | |||
interpretation | |||
i_create_character_data?: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs type_wf create_character_data known_ptr | |||
by(auto simp add: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def create_character_data_def instances) | |||
i_create_character_data?: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes | |||
get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs | |||
type_wf create_character_data known_ptr | |||
by(auto simp add: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def | |||
create_character_data_def instances) | |||
declare l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances] | |||
@@ -3612,11 +3695,11 @@ definition a_get_elements_by_class_name :: "(_) object_ptr \<Rightarrow> attr_va | |||
definition a_get_elements_by_tag_name :: "(_) object_ptr \<Rightarrow> attr_value \<Rightarrow> (_, (_) element_ptr list) dom_prog" | |||
where | |||
"a_get_elements_by_tag_name ptr tag_name = to_tree_order ptr \<bind> | |||
"a_get_elements_by_tag_name ptr tag = to_tree_order ptr \<bind> | |||
map_filter_M (\<lambda>ptr. (case cast ptr of | |||
Some element_ptr \<Rightarrow> do { | |||
this_tag_name \<leftarrow> get_M element_ptr tag_type; | |||
(if this_tag_name = tag_name then return (Some element_ptr) else return None) | |||
this_tag_name \<leftarrow> get_M element_ptr tag_name; | |||
(if this_tag_name = tag then return (Some element_ptr) else return None) | |||
} | |||
| _ \<Rightarrow> return None))" | |||
end | |||
@@ -3631,7 +3714,8 @@ l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M | |||
defines | |||
get_element_by_id = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_element_by_id first_in_tree_order get_attribute" | |||
and | |||
get_elements_by_class_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name to_tree_order get_attribute" | |||
get_elements_by_class_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name | |||
to_tree_order get_attribute" | |||
and | |||
get_elements_by_tag_name = "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_tag_name to_tree_order" . | |||
@@ -3642,13 +3726,17 @@ locale l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\ | |||
l_to_tree_order to_tree_order + | |||
l_get_attribute type_wf get_attribute get_attribute_locs | |||
for to_tree_order :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog" | |||
and first_in_tree_order :: "(_) object_ptr \<Rightarrow> ((_) object_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog) | |||
and first_in_tree_order :: | |||
"(_) object_ptr \<Rightarrow> ((_) object_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog) | |||
\<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog" | |||
and get_attribute :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, char list option) prog" | |||
and get_attribute_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" | |||
and get_element_by_id :: "(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog" | |||
and get_elements_by_class_name :: "(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr list) prog" | |||
and get_elements_by_tag_name :: "(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr list) prog" | |||
and get_element_by_id :: | |||
"(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog" | |||
and get_elements_by_class_name :: | |||
"(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr list) prog" | |||
and get_elements_by_tag_name :: | |||
"(_) object_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr list) prog" | |||
and type_wf :: "(_) heap \<Rightarrow> bool" + | |||
assumes get_element_by_id_impl: "get_element_by_id = a_get_element_by_id" | |||
assumes get_elements_by_class_name_impl: "get_elements_by_class_name = a_get_elements_by_class_name" | |||
@@ -3696,7 +3784,7 @@ lemma get_elements_by_tag_name_result_in_tree_order: | |||
intro!: map_filter_M_pure map_M_pure_I bind_pure_I | |||
split: option.splits list.splits if_splits) | |||
lemma get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag_name) h" | |||
lemma get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag) h" | |||
by(auto simp add: get_elements_by_tag_name_def | |||
intro!: bind_pure_I map_filter_M_pure | |||
split: option.splits) | |||
@@ -3706,7 +3794,7 @@ locale l_get_element_by = l_get_element_by_defs + l_to_tree_order_defs + | |||
assumes get_element_by_id_result_in_tree_order: | |||
"h \<turnstile> get_element_by_id ptr iden \<rightarrow>\<^sub>r Some element_ptr \<Longrightarrow> h \<turnstile> to_tree_order ptr \<rightarrow>\<^sub>r to | |||
\<Longrightarrow> cast element_ptr \<in> set to" | |||
assumes get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag_name) h" | |||
assumes get_elements_by_tag_name_pure [simp]: "pure (get_elements_by_tag_name ptr tag) h" | |||
interpretation | |||
i_get_element_by?: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order first_in_tree_order get_attribute | |||
@@ -164,7 +164,8 @@ lemma get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub> | |||
\<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)) | |||
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 | |||
@@ -258,14 +259,16 @@ lemma new\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub> | |||
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) | |||
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) | |||
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')" | |||
@@ -337,7 +340,9 @@ lemma known_ptrs_preserved: | |||
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'" | |||
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 . | |||
@@ -136,7 +136,8 @@ lemma get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_type_w | |||
shows "document_ptr |\<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) | |||
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 | |||
@@ -195,12 +196,14 @@ lemma get_document_ptr_simp2 [simp]: | |||
lemma get_document_ptr_simp3 [simp]: | |||
"get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr f h) = get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr h" | |||
by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) | |||
lemma get_document_ptr_simp4 [simp]: "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" | |||
lemma get_document_ptr_simp4 [simp]: | |||
"get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t element_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" | |||
by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) | |||
lemma get_document_ptr_simp5 [simp]: | |||
"get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr (put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr f h) = get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr h" | |||
by(auto simp add: get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def put\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) | |||
lemma get_document_ptr_simp6 [simp]: "get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" | |||
lemma get_document_ptr_simp6 [simp]: | |||
"get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr (put\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a character_data_ptr f h) = get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t document_ptr h" | |||
by(auto simp add: get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def put\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def) | |||
lemma new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t [simp]: | |||
@@ -327,7 +330,9 @@ lemma known_ptrs_preserved: | |||
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'" | |||
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 . | |||
@@ -181,18 +181,23 @@ definition a_known_ptrs :: "(_) heap \<Rightarrow> bool" | |||
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'" | |||
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'" | |||
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'" | |||
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 | |||
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" | |||
@@ -127,9 +127,13 @@ lemmas known_ptr_defs = a_known_ptr_def | |||
locale l_known_ptrs = l_known_ptr known_ptr for known_ptr :: "(_) object_ptr \<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'" | |||
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 | |||
@@ -142,11 +146,15 @@ lemma known_ptrs_known_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'" | |||
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'" | |||
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'" | |||
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 . | |||
@@ -36,8 +36,8 @@ theory BaseMonad | |||
begin | |||
subsection\<open>Datatypes\<close> | |||
datatype exception = NotFoundError | SegmentationFault | HierarchyRequestError | AssertException | |||
| NonTerminationException | InvokeError | TypeError | DebugException nat | |||
datatype exception = NotFoundError | HierarchyRequestError | NotSupportedError | SegmentationFault | |||
| AssertException | NonTerminationException | InvokeError | TypeError | |||
lemma finite_set_in [simp]: "x \<in> fset FS \<longleftrightarrow> x |\<in>| FS" | |||
by (meson notin_fset) | |||
@@ -149,11 +149,19 @@ proof (unfold comp_def, rule ccpo.admissibleI, clarify) | |||
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 | |||
using CollectD Inl_Inr_False prog.sel chain_fun[OF 1] flat_lub_in_chain[OF chain_fun[OF 1]] 2 4 | |||
unfolding execute_def fun_lub_def | |||
proof - | |||
assume a1: "the_prog (Prog (\<lambda>x. flat_lub (Inl e) {y. \<exists>f\<in>A. y = f x})) h = Inr (r, h2)" | |||
assume a2: "\<forall>xa\<in>A. \<forall>h h2 r. the_prog (Prog xa) h = Inr (r, h2) \<longrightarrow> P h h2 r" | |||
have "Inr (r, h2) \<in> {s. \<exists>f. f \<in> A \<and> s = f h} \<or> Inr (r, h2) = Inl e" | |||
using a1 by (metis (lifting) \<open>\<And>aa a. flat_lub (Inl e) {y. \<exists>f\<in>A. y = f aa} = a \<Longrightarrow> a = Inl e \<or> a \<in> {y. \<exists>f\<in>A. y = f aa}\<close> prog.sel) | |||
then show ?thesis | |||
using a2 by fastforce | |||
qed | |||
qed | |||
lemma execute_admissible2: | |||
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)" | |||
@@ -171,11 +179,11 @@ proof (unfold comp_def, rule ccpo.admissibleI, clarify) | |||
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 | |||
by (metis (mono_tags, lifting) Collect_cong Inl_Inr_False prog.sel) | |||
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 | |||
by (metis (no_types, lifting) Collect_cong Inl_Inr_False prog.sel) | |||
ultimately obtain f where | |||
"f \<in> A" and | |||
"h \<turnstile> Prog f = Inr (r, h2)" and | |||
@@ -308,7 +308,7 @@ lemma type_wf_put_ptr_not_in_heap_E: | |||
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) | |||
split: option.splits if_splits)[1] | |||
using assms(2) node_ptr_kinds_commutes by blast | |||
lemma type_wf_put_ptr_in_heap_E: | |||
@@ -319,7 +319,8 @@ lemma type_wf_put_ptr_in_heap_E: | |||
shows "type_wf h" | |||
using assms | |||
apply(auto simp add: type_wf_defs split: option.splits if_splits)[1] | |||
by (metis (no_types, lifting) ElementClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf assms(2) bind.bind_lunit cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def notin_fset option.collapse) | |||
by (metis (no_types, lifting) ElementClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf assms(2) bind.bind_lunit | |||
cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_inv cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>N\<^sub>o\<^sub>d\<^sub>e_inv get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def notin_fset option.collapse) | |||
subsection\<open>Preserving Types\<close> | |||
@@ -340,8 +341,8 @@ 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'" | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: | |||
"h \<turnstile> put_M element_ptr tag_name_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 | |||
@@ -526,6 +527,8 @@ lemma type_wf_drop: "type_wf h \<Longrightarrow> type_wf (Heap (fmdrop ptr (the_ | |||
apply(auto simp add: type_wf_def ElementMonad.type_wf_drop | |||
l_type_wf_def\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a.a_type_wf_def)[1] | |||
using type_wf_drop | |||
by (metis (no_types, lifting) ElementClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf character_data_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def node_ptr_kinds_commutes object_ptr_kinds_code5) | |||
by (metis (no_types, lifting) ElementClass.type_wf\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ObjectClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf | |||
character_data_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>C\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>D\<^sub>a\<^sub>t\<^sub>a_def get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_def | |||
get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def node_ptr_kinds_commutes object_ptr_kinds_code5) | |||
end |
@@ -322,7 +322,8 @@ lemma type_wf_put_ptr_in_heap_E: | |||
using assms | |||
apply(auto simp add: type_wf_defs elim!: CharacterDataMonad.type_wf_put_ptr_in_heap_E | |||
split: option.splits if_splits)[1] | |||
by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def is_document_kind_def notin_fset option.exhaust_sel) | |||
by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf bind.bind_lunit get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def | |||
is_document_kind_def notin_fset option.exhaust_sel) | |||
@@ -347,8 +348,8 @@ lemma new_element_is_l_new_element [instances]: | |||
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'" | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: | |||
"h \<turnstile> put_M element_ptr tag_name_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 | |||
@@ -360,7 +361,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_type_typ | |||
apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs NodeClass.type_wf_defs | |||
ElementMonad.get_M_defs ObjectClass.type_wf_defs | |||
CharacterDataClass.type_wf_defs split: option.splits)[1] | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def | |||
bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse | |||
option.distinct(1) option.simps(3)) | |||
by (metis fmember.rep_eq) | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_type_wf_preserved [simp]: | |||
@@ -376,7 +379,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_child_nodes_ | |||
apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs | |||
NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs | |||
CharacterDataClass.type_wf_defs split: option.splits)[1] | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def | |||
bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse | |||
option.distinct(1) option.simps(3)) | |||
by (metis fmember.rep_eq) | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_wf_preserved [simp]: | |||
@@ -392,7 +397,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_attrs_type_w | |||
apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs | |||
NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs | |||
CharacterDataClass.type_wf_defs split: option.splits)[1] | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def | |||
bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse | |||
option.distinct(1) option.simps(3)) | |||
by (metis fmember.rep_eq) | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_opt_type_wf_preserved [simp]: | |||
@@ -408,7 +415,9 @@ lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_shadow_root_ | |||
apply(auto simp add: is_node_kind_def type_wf_defs ElementClass.type_wf_defs | |||
NodeClass.type_wf_defs ElementMonad.get_M_defs ObjectClass.type_wf_defs | |||
CharacterDataClass.type_wf_defs split: option.splits)[1] | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse option.distinct(1) option.simps(3)) | |||
apply (metis NodeClass.a_type_wf_def NodeClass.get\<^sub>N\<^sub>o\<^sub>d\<^sub>e_type_wf ObjectClass.a_type_wf_def | |||
bind.bind_lzero finite_set_in get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def l_type_wf_def\<^sub>N\<^sub>o\<^sub>d\<^sub>e.a_type_wf_def option.collapse | |||
option.distinct(1) option.simps(3)) | |||
by (metis fmember.rep_eq) | |||
lemma new_character_data_type_wf_preserved [simp]: | |||
@@ -458,7 +467,8 @@ lemma new_document_type_wf_preserved [simp]: "h \<turnstile> new_document \<righ | |||
split: option.splits)[1] | |||
using document_ptrs_def apply fastforce | |||
apply (simp add: is_document_kind_def) | |||
apply (metis Suc_n_not_le_n document_ptr.sel(1) document_ptrs_def fMax_ge ffmember_filter fimage_eqI is_document_ptr_ref) | |||
apply (metis Suc_n_not_le_n document_ptr.sel(1) document_ptrs_def fMax_ge ffmember_filter | |||
fimage_eqI is_document_ptr_ref) | |||
done | |||
locale l_new_document = l_type_wf + | |||
@@ -498,7 +508,7 @@ lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_doct | |||
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) | |||
apply(auto simp add: get_M_defs)[1] | |||
by (metis (mono_tags) error_returns_result finite_set_in option.exhaust_sel option.simps(4)) | |||
lemma put_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_document_element_type_wf_preserved [simp]: | |||
@@ -599,5 +609,6 @@ lemma type_wf_drop: "type_wf h \<Longrightarrow> type_wf (Heap (fmdrop ptr (the_ | |||
apply(auto simp add: type_wf_defs)[1] | |||
using type_wf_drop | |||
apply blast | |||
by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf CharacterDataMonad.type_wf_drop document_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def heap.sel) | |||
by (metis (no_types, lifting) CharacterDataClass.get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_type_wf CharacterDataMonad.type_wf_drop | |||
document_ptr_kinds_commutes finite_set_in fmlookup_drop get\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def get\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def heap.sel) | |||
end |
@@ -233,10 +233,10 @@ lemma new_element_child_nodes: | |||
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: | |||
lemma new_element_tag_name: | |||
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 ''''" | |||
shows "h' \<turnstile> get_M new_element_ptr tag_name \<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) | |||
@@ -338,8 +338,8 @@ 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'" | |||
lemma put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_tag_name_type_wf_preserved [simp]: | |||
"h \<turnstile> put_M element_ptr tag_name_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 | |||
@@ -165,7 +165,7 @@ lemma type_wf_put_ptr_in_heap_E: | |||
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) | |||
apply(auto simp add: type_wf_defs split: option.splits if_splits)[1] | |||
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) | |||
@@ -192,7 +192,7 @@ lemma type_wf_preserved_small: | |||
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: type_wf_defs)[1] | |||
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)) | |||
@@ -93,7 +93,8 @@ definition | |||
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)" | |||
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") | |||
@@ -452,32 +453,12 @@ fun forall_M :: "('y \<Rightarrow> ('heap, 'e, 'result) prog) \<Rightarrow> 'y l | |||
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> | |||
@@ -506,7 +487,8 @@ lemma filter_M_pure_I [intro]: "(\<And>x. x \<in> set xs \<Longrightarrow> pure | |||
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)" | |||
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) | |||
@@ -518,7 +500,8 @@ lemma filter_M_not_more_elements: | |||
by(auto elim!: bind_returns_result_E2 split: if_splits intro!: set_ConsD) | |||
lemma filter_M_in_result_if_ok: | |||
assumes "h \<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" | |||
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) | |||
@@ -730,7 +713,8 @@ definition preserved :: "('heap, 'e, 'result) prog \<Rightarrow> 'heap \<Rightar | |||
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)))" | |||
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 | |||
@@ -768,13 +752,16 @@ lemma reads_bind_pure: | |||
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'" | |||
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'" | |||
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'" | |||
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'" | |||
@@ -75,10 +75,12 @@ val _ = Theory.setup | |||
handle Timeout.TIMEOUT _ => NONE; | |||
val t2 = Time.now() - start2; | |||
in | |||
if length (Seq.list_of result) > 0 then (Output.information ("eval took " ^ (Time.toString t)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t ^ ",")) else (); | |||
if length (Seq.list_of result) > 0 then (Output.information ("eval took " ^ (Time.toString t)); | |||
File.append (Path.explode "/tmp/isabellebench") (Time.toString t ^ ",")) else (); | |||
(case result2_opt of | |||
SOME result2 => | |||
(if length (Seq.list_of result2) > 0 then (Output.information ("code_simp took " ^ (Time.toString t2)); File.append (Path.explode "/tmp/isabellebench") (Time.toString t2 ^ "\n")) else ()) | |||
(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))) | |||
@@ -142,19 +142,23 @@ fun get_element_by_id_with_null :: "((_::linorder) object_ptr option) \<Rightarr | |||
| "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" | |||
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" | |||
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)" | |||
"get_elements_by_tag_name_with_null (Some ptr) tag = | |||
get_elements_by_tag_name ptr tag \<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" | |||
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 { | |||
@@ -165,7 +169,8 @@ fun insert_before_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> | |||
| 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" | |||
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 | |||
@@ -180,7 +185,8 @@ fun get_body :: "((_::linorder) object_ptr option) \<Rightarrow> (_, ((_) object | |||
}" | |||
notation get_body ("_ . body") | |||
fun get_document_element_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> (_, ((_) object_ptr option)) dom_prog" | |||
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 { | |||
@@ -190,14 +196,16 @@ fun get_document_element_with_null :: "((_::linorder) object_ptr option) \<Right | |||
| 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" | |||
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" | |||
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 { | |||
@@ -208,7 +216,8 @@ fun remove_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> ((_) ob | |||
| "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" | |||
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 { | |||
@@ -222,7 +231,7 @@ 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)" | |||
Some element_ptr \<Rightarrow> get_M element_ptr tag_name)" | |||
notation get_tag_name_with_null ("_ . tagName") | |||
abbreviation "remove_attribute_with_null ptr k \<equiv> set_attribute_with_null2 ptr k None" | |||
@@ -256,7 +265,8 @@ fun first_child_with_null :: "((_) object_ptr option) \<Rightarrow> (_, ((_) obj | |||
| 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" | |||
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 | |||
@@ -266,7 +276,8 @@ fun adopt_node_with_null :: "((_::linorder) object_ptr option) \<Rightarrow> ((_ | |||
notation adopt_node_with_null ("_ . adoptNode'(_')") | |||
definition createTestTree :: "((_::linorder) object_ptr option) \<Rightarrow> (_, (string \<Rightarrow> (_, ((_) object_ptr option)) dom_prog)) dom_prog" | |||
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)" | |||
@@ -10,7 +10,7 @@ | |||
\DeclareOldFontCommand{\bf}{\normalfont\bfseries}{\mathbf} | |||
\DeclareOldFontCommand{\it}{\normalfont\itshape}{\mathit} | |||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |||
\usepackage[USenglish]{babel} | |||
\usepackage[english]{babel} | |||
\usepackage[numbers, sort&compress]{natbib} | |||
\usepackage{isabelle,isabellesym} | |||
\usepackage{booktabs} | |||
@@ -50,8 +50,6 @@ | |||
\begingroup% | |||
\def\isacharunderscore{\textunderscore}% | |||
\section{#1 (\thy)}% | |||
\def\isacharunderscore{-}% | |||
\expandafter\label{sec:\isabellecontext}% | |||
\endgroup% | |||
} | |||
@@ -39,43 +39,52 @@ text\<open>The type @{type "DOMString"} is a type synonym for @{type "string"}, | |||
type_synonym attr_key = DOMString | |||
type_synonym attr_value = DOMString | |||
type_synonym attrs = "(attr_key, attr_value) fmap" | |||
type_synonym tag_type = DOMString | |||
type_synonym tag_name = DOMString | |||
record ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr) RElement = RNode + | |||
nothing :: unit | |||
tag_type :: tag_type | |||
tag_name :: tag_name | |||
child_nodes :: "('node_ptr, 'element_ptr, 'character_data_ptr) node_ptr list" | |||
attrs :: attrs | |||
shadow_root_opt :: "'shadow_root_ptr shadow_root_ptr option" | |||
type_synonym | |||
('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element | |||
= "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_scheme" | |||
= "('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) | |||
RElement_scheme" | |||
register_default_tvars | |||
"('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element) Element" | |||
type_synonym | |||
('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node | |||
= "(('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Node" | |||
= "(('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext | |||
+ 'Node) Node" | |||
register_default_tvars | |||
"('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Node, 'Element) Node" | |||
type_synonym | |||
('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object | |||
= "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) Object" | |||
= "('Object, ('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) | |||
RElement_ext + 'Node) Object" | |||
register_default_tvars | |||
"('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) Object" | |||
type_synonym | |||
('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) heap | |||
= "('document_ptr document_ptr + 'shadow_root_ptr shadow_root_ptr + 'object_ptr, 'element_ptr element_ptr + 'character_data_ptr character_data_ptr + 'node_ptr, 'Object, | |||
('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + 'Node) heap" | |||
('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, | |||
'Object, 'Node, 'Element) heap | |||
= "('document_ptr document_ptr + 'shadow_root_ptr shadow_root_ptr + 'object_ptr, | |||
'element_ptr element_ptr + 'character_data_ptr character_data_ptr + 'node_ptr, 'Object, | |||
('node_ptr, 'element_ptr, 'character_data_ptr, 'shadow_root_ptr, 'Element option) RElement_ext + | |||
'Node) heap" | |||
register_default_tvars | |||
"('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, 'Object, 'Node, 'Element) heap" | |||
"('object_ptr, 'node_ptr, 'element_ptr, 'character_data_ptr, 'document_ptr, 'shadow_root_ptr, | |||
'Object, 'Node, 'Element) heap" | |||
type_synonym heap\<^sub>f\<^sub>i\<^sub>n\<^sub>a\<^sub>l = "(unit, unit, unit, unit, unit, unit, unit, unit, unit) heap" | |||
definition element_ptr_kinds :: "(_) heap \<Rightarrow> (_) element_ptr fset" | |||
where | |||
"element_ptr_kinds heap = the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| (ffilter is_element_ptr_kind (node_ptr_kinds heap)))" | |||
"element_ptr_kinds heap = | |||
the |`| (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r |`| (ffilter is_element_ptr_kind (node_ptr_kinds heap)))" | |||
lemma element_ptr_kinds_simp [simp]: | |||
"element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = {|element_ptr|} |\<union>| element_ptr_kinds h" | |||
"element_ptr_kinds (Heap (fmupd (cast element_ptr) element (the_heap h))) = | |||
{|element_ptr|} |\<union>| element_ptr_kinds h" | |||
apply(auto simp add: element_ptr_kinds_def)[1] | |||
by force | |||
@@ -85,7 +94,8 @@ definition element_ptrs :: "(_) heap \<Rightarrow> (_) element_ptr fset" | |||
definition cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) Node \<Rightarrow> (_) Element option" | |||
where | |||
"cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t node = (case RNode.more node of Inl element \<Rightarrow> Some (RNode.extend (RNode.truncate node) element) | _ \<Rightarrow> None)" | |||
"cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t node = | |||
(case RNode.more node of Inl element \<Rightarrow> Some (RNode.extend (RNode.truncate node) element) | _ \<Rightarrow> None)" | |||
adhoc_overloading cast cast\<^sub>N\<^sub>o\<^sub>d\<^sub>e\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t | |||
abbreviation cast\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>2\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) Object \<Rightarrow> (_) Element option" | |||
@@ -210,9 +220,9 @@ lemma get_elment_ptr_simp2 [simp]: | |||
by(auto simp add: get\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def put\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_def) | |||
abbreviation "create_element_obj tag_type_arg child_nodes_arg attrs_arg shadow_root_opt_arg | |||
abbreviation "create_element_obj tag_name_arg child_nodes_arg attrs_arg shadow_root_opt_arg | |||
\<equiv> \<lparr> RObject.nothing = (), RNode.nothing = (), RElement.nothing = (), | |||
tag_type = tag_type_arg, Element.child_nodes = child_nodes_arg, attrs = attrs_arg, | |||
tag_name = tag_name_arg, Element.child_nodes = child_nodes_arg, attrs = attrs_arg, | |||
shadow_root_opt = shadow_root_opt_arg, \<dots> = None \<rparr>" | |||
definition new\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t :: "(_) heap \<Rightarrow> ((_) element_ptr \<times> (_) heap)" | |||
@@ -298,11 +308,15 @@ lemma known_ptrs_known_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'" | |||
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'" | |||
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'" | |||
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>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t known_ptr defines known_ptrs = a_known_ptrs . | |||