Commit 7445e476 authored by Niels Mündler's avatar Niels Mündler
Browse files

Add imperative deletion operation and OCaml code export to BTree entry

parent 1edcb594d89c
......@@ -10349,7 +10349,7 @@ abstract =
In this work, we use the interactive theorem prover Isabelle/HOL to
verify an imperative implementation of the classical B-tree data
structure invented by Bayer and McCreight [ACM 1970]. The
implementation supports set membership and insertion queries with
implementation supports set membership, insertion and deletion queries with
efficient binary search for intra-node navigation. This is
accomplished by first specifying the structure abstractly in the
functional modeling language HOL and proving functional correctness.
......@@ -10358,12 +10358,18 @@ abstract =
separation logic utilities from the <a
href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html">
Isabelle Refinement Framework </a> . The code can be exported to
the programming languages SML and Scala. We examine the runtime of all
the programming languages SML, OCaml and Scala. We examine the runtime of all
operations indirectly by reproducing results of the logarithmic
relationship between height and the number of nodes. The results are
discussed in greater detail in the corresponding <a
href="https://mediatum.ub.tum.de/1596550">Bachelor's
Thesis</a>.
extra-history =
Change history:
[2021-05-02]:
Add implementation and proof of correctness of imperative deletion operations.
Further add the option to export code to OCaml.
<br>
 
[Sunflowers]
title = The Sunflower Lemma of Erdős and Rado
......
......@@ -2,6 +2,26 @@ theory Array_SBlit
imports "Separation_Logic_Imperative_HOL.Array_Blit"
begin
(* Resolves TODO by Peter Lammich *)
(* OCaml handles the case of len=0 correctly (i.e.
as specified by the Hoare Triple in Array_Blit
not generating an exception if si+len \<le> array length and such) *)
code_printing code_module "array_blit" \<rightharpoonup> (OCaml)
\<open>
let array_blit src si dst di len = (
if src=dst then
raise (Invalid_argument "array_blit: Same arrays")
else
Array.blit src (Z.to_int si) dst (Z.to_int di) (Z.to_int len)
)
\<close>
code_printing constant blit' \<rightharpoonup>
(OCaml) "(fun () -> /array'_blit _ _ _ _ _)"
export_code blit checking OCaml
section "Same array Blit"
text "The standard framework already provides a function to copy array
......@@ -117,7 +137,6 @@ next
have[simp]: "take len (drop si (lsrc[di + len := lsrc ! (si + len)]))
= take len (drop si lsrc)"
sledgehammer
by (metis Suc.prems(2) ab_semigroup_add_class.add.commute add_le_cancel_right take_drop take_update_cancel)
have [simp]: "drop (di + len) (lsrc[di + len := lsrc ! (si + len)])
= lsrc ! (si+len) # drop (Suc di + len) lsrc"
......@@ -173,8 +192,10 @@ thm safe_sblit_rule
subsection "Code Generator Setup"
text "Note that the requirement for correctness
is even weaker here than in SML.
We therefore manually handle the case where length is 0 (in which case nothing happens at all)."
is even weaker here than in SML/OCaml.
In particular, if the length of the slice to copy is equal to 0,
we will never throw an exception.
We therefore manually handle this case, where nothing happens at all."
code_printing code_module "array_sblit" \<rightharpoonup> (SML)
\<open>
......@@ -188,6 +209,15 @@ code_printing code_module "array_sblit" \<rightharpoonup> (SML)
)
\<close>
code_printing code_module "array_sblit" \<rightharpoonup> (OCaml)
\<open>
let array_sblit src si di len = (
if len > Z.zero then
(Array.blit src (Z.to_int si) src (Z.to_int di) (Z.to_int len))
else ()
)
\<close>
definition safe_sblit' where
[code del]: "safe_sblit' src si di len
= safe_sblit src (nat_of_integer si) (nat_of_integer di)
......@@ -198,7 +228,7 @@ lemma [code]:
= safe_sblit' src (integer_of_nat si) (integer_of_nat di)
(integer_of_nat len)" by (simp add: safe_sblit'_def)
(* TODO: Export to other languages: OCaml, Haskell *)
(* TODO: Export to other languages: Haskell *)
code_printing constant safe_sblit' \<rightharpoonup>
(SML) "(fn/ ()/ => /array'_sblit _ _ _ _)"
and (Scala) "{ ('_: Unit)/=>/
......@@ -211,7 +241,13 @@ code_printing constant safe_sblit' \<rightharpoonup>
safescopy(_.array,_.toInt,_.toInt,_.toInt)
}"
export_code safe_sblit checking SML Scala
code_printing constant safe_sblit' \<rightharpoonup>
(OCaml) "(fun () -> /array'_sblit _ _ _ _)"
export_code safe_sblit checking SML Scala OCaml
subsection "Derived operations"
......
......@@ -254,12 +254,13 @@ definition rebalance_middle_tree:: "nat \<Rightarrow> (('a::{default,heap,linord
"rebalance_middle_tree \<equiv> \<lambda> k tsi i r_ti. (
case r_ti of
None \<Rightarrow> do {
return (Btnode tsi r_ti)
(r_sub,sep) \<leftarrow> pfa_get tsi i;
case r_sub of None \<Rightarrow> return (Btnode tsi r_ti)
} |
Some p_t \<Rightarrow> do {
ti \<leftarrow> !p_t;
(r_sub,sep) \<leftarrow> pfa_get tsi i;
case r_sub of (Some p_sub) \<Rightarrow> do {
ti \<leftarrow> !p_t;
sub \<leftarrow> !p_sub;
l_sub \<leftarrow> pfa_length (kvs sub);
l_tts \<leftarrow> pfa_length (kvs ti);
......@@ -267,13 +268,16 @@ definition rebalance_middle_tree:: "nat \<Rightarrow> (('a::{default,heap,linord
return (Btnode tsi r_ti)
} else do {
l_tsi \<leftarrow> pfa_length tsi;
if l_tsi = i then do {
if i+1 = l_tsi then do {
mts' \<leftarrow> pfa_append_extend_grow (kvs sub) (last sub,sep) (kvs ti);
res_node\<^sub>i \<leftarrow> node\<^sub>i k mts' (last ti);
case res_node\<^sub>i of
T\<^sub>i u \<Rightarrow> return (Btnode tsi u) |
T\<^sub>i u \<Rightarrow> do {
tsi' \<leftarrow> pfa_shrink i tsi;
return (Btnode tsi' u)
} |
Up\<^sub>i l a r \<Rightarrow> do {
tsi' \<leftarrow> pfa_append tsi (l,a);
tsi' \<leftarrow> pfa_set tsi i (l,a);
return (Btnode tsi' r)
}
} else do {
......@@ -284,8 +288,8 @@ definition rebalance_middle_tree:: "nat \<Rightarrow> (('a::{default,heap,linord
res_node\<^sub>i \<leftarrow> node\<^sub>i k mts' (last rsub);
case res_node\<^sub>i of
T\<^sub>i u \<Rightarrow> do {
tsi' \<leftarrow> pfa_set tsi (i+1) (u,rsep);
tsi'' \<leftarrow> pfa_delete tsi' i;
tsi' \<leftarrow> pfa_set tsi i (u,rsep);
tsi'' \<leftarrow> pfa_delete tsi' (i+1);
return (Btnode tsi'' r_ti)
} |
Up\<^sub>i l a r \<Rightarrow> do {
......@@ -308,80 +312,6 @@ definition rebalance_last_tree:: "nat \<Rightarrow> (('a::{default,heap,linorder
rebalance_middle_tree k tsi (l_tsi-1) ti
}"
partial_function (heap) split_max ::"nat \<Rightarrow> ('a::{default,heap,linorder}) btnode ref option \<Rightarrow> ('a btnode ref option \<times> 'a) Heap"
where
"split_max k r_t = (case r_t of Some p_t \<Rightarrow> do {
t \<leftarrow> !p_t;
(case t of Btnode tsi r_ti \<Rightarrow>
case r_ti of None \<Rightarrow> do {
(sub,sep) \<leftarrow> pfa_last tsi;
tsi' \<leftarrow> pfa_butlast tsi;
p_t := Btnode tsi' sub;
return (Some p_t, sep)
} |
_ \<Rightarrow> do {
(sub,sep) \<leftarrow> split_max k r_ti;
p_t' \<leftarrow> rebalance_last_tree k tsi sub;
p_t := p_t';
return (Some p_t, sep)
})
})
"
partial_function (heap) del ::"nat \<Rightarrow> 'a \<Rightarrow> ('a::{default,heap,linorder}) btnode ref option \<Rightarrow> 'a btnode ref option Heap"
where
"del k x ti = (case ti of None \<Rightarrow> return None |
Some p \<Rightarrow> do {
node \<leftarrow> !p;
i \<leftarrow> imp_split (kvs node) x;
tsl \<leftarrow> pfa_length (kvs node);
if i < tsl then do {
s \<leftarrow> pfa_get (kvs node) i;
let (sub,sep) = s in
if x \<noteq> sep then do {
sub' \<leftarrow> del k x sub;
kvs' \<leftarrow> pfa_set (kvs node) i (sub',sep);
node' \<leftarrow> rebalance_middle_tree k kvs' i (last node);
ti' \<leftarrow> ref node';
return (Some ti')
}
else if sub = None then do{
pfa_delete (kvs node) i;
return ti
}
else do {
sm \<leftarrow> split_max k sub;
kvs' \<leftarrow> pfa_set (kvs node) i sm;
node' \<leftarrow> rebalance_middle_tree k kvs' i (last node);
ti' \<leftarrow> ref node';
return (Some ti')
}
} else do {
t' \<leftarrow> del k x (last node);
node' \<leftarrow> rebalance_last_tree k (kvs node) t';
ti' \<leftarrow> ref node';
return (Some ti')
}
})
"
partial_function (heap) reduce_root ::"('a::{default,heap,linorder}) btnode ref option \<Rightarrow> 'a btnode ref option Heap"
where
"reduce_root ti = (case ti of
None \<Rightarrow> return None |
Some p_t \<Rightarrow> do {
node \<leftarrow> !p_t;
tsl \<leftarrow> pfa_length (kvs node);
case tsl of 0 \<Rightarrow> return (last node) |
_ \<Rightarrow> return ti
})"
partial_function (heap) delete ::"nat \<Rightarrow> 'a \<Rightarrow> ('a::{default,heap,linorder}) btnode ref option \<Rightarrow> 'a btnode ref option Heap"
where
"delete k x ti = do {
ti' \<leftarrow> del k x ti;
reduce_root ti'
}"
subsection "Refinement of the abstract B-tree operations"
......@@ -871,6 +801,10 @@ lemma insert_rule':
using abs_split.insert_bal abs_split.insert_order abs_split.insert_inorder
by (sep_auto heap: insert_rule simp add: sorted_ins_list)
lemma list_update_length2 [simp]:
"(xs @ x # y # ys)[Suc (length xs) := z] = (xs @ x # z # ys)"
by (induct xs, auto)
lemma node\<^sub>i_rule_ins: "\<lbrakk>2*k \<le> c; c \<le> 4*k+1; length ls = length lsi\<rbrakk> \<Longrightarrow>
<is_pfa c (lsi @ (li, ai) # rsi) (aa, al) *
......@@ -878,8 +812,9 @@ lemma node\<^sub>i_rule_ins: "\<lbrakk>2*k \<le> c; c \<le> 4*k+1; length ls = l
btree_assn k l li *
id_assn a ai *
blist_assn k rs rsi *
btree_assn k t ti> node\<^sub>i k (aa, al)
ti <btupi_assn k (abs_split.node\<^sub>i k (ls @ (l, a) # rs) t)>\<^sub>t"
btree_assn k t ti>
node\<^sub>i k (aa, al) ti
<btupi_assn k (abs_split.node\<^sub>i k (ls @ (l, a) # rs) t)>\<^sub>t"
proof -
assume [simp]: "2*k \<le> c" "c \<le> 4*k+1" "length ls = length lsi"
moreover note node\<^sub>i_rule[of k c "(lsi @ (li, ai) # rsi)" aa al "(ls @ (l, a) # rs)" t ti]
......@@ -887,6 +822,870 @@ proof -
by (simp add: mult.left_assoc list_assn_aux_append_Cons)
qed
lemma btupi_assn_T: "h \<Turnstile> btupi_assn k (abs_split.node\<^sub>i k ts t) (T\<^sub>i x) \<Longrightarrow> abs_split.node\<^sub>i k ts t = abs_split.T\<^sub>i (Node ts t)"
apply(auto simp add: abs_split.node\<^sub>i.simps dest!: mod_starD split!: list.splits)
done
lemma btupi_assn_Up: "h \<Turnstile> btupi_assn k (abs_split.node\<^sub>i k ts t) (Up\<^sub>i l a r) \<Longrightarrow>
abs_split.node\<^sub>i k ts t = (
case BTree_Set.split_half ts of (ls, (sub,sep)#rs) \<Rightarrow>
abs_split.Up\<^sub>i (Node ls sub) sep (Node rs t))"
apply(auto simp add: abs_split.node\<^sub>i.simps dest!: mod_starD split!: list.splits)
done
lemma second_last_access:"(xs@a#b#ys) ! Suc(length xs) = b"
by (simp add: nth_via_drop)
lemma pfa_assn_len:"h \<Turnstile> is_pfa k ls (a,n) \<Longrightarrow> n \<le> k \<and> length ls = n"
by (auto simp add: is_pfa_def)
(*declare "impCE"[rule del]*)
lemma rebalance_middle_tree_rule:
assumes "height t = height sub"
and "case rs of (rsub,rsep) # list \<Rightarrow> height rsub = height t | [] \<Rightarrow> True"
and "i = length ls"
shows "<is_pfa (2*k) tsi (a,n) * blist_assn k (ls@(sub,sep)#rs) tsi * btree_assn k t ti>
rebalance_middle_tree k (a,n) i ti
<\<lambda>r. btnode_assn k (abs_split.rebalance_middle_tree k ls sub sep rs t) r >\<^sub>t"
apply(simp add: list_assn_append_Cons_left)
apply(rule norm_pre_ex_rule)+
proof(goal_cases)
case (1 lsi z rsi)
then show ?case
proof(cases z)
case z_split: (Pair subi sepi)
then show ?thesis
proof(cases sub)
case sub_leaf[simp]: Leaf
then have t_leaf[simp]: "t = Leaf" using assms
by (cases t) auto
show ?thesis
apply (subst rebalance_middle_tree_def)
apply (rule hoare_triple_preI)
apply (vcg)
using assms apply (auto dest!: mod_starD list_assn_len split!: option.splits)
apply (vcg)
apply (auto dest!: mod_starD list_assn_len split!: option.splits)
apply (rule ent_ex_postI[where x=tsi])
apply sep_auto
done
next
case sub_node[simp]: (Node mts mt)
then obtain tts tt where t_node[simp]: "t = Node tts tt" using assms
by (cases t) auto
then show ?thesis
proof(cases "length mts \<ge> k \<and> length tts \<ge> k")
case True
then show ?thesis
apply(subst rebalance_middle_tree_def)
apply(rule hoare_triple_preI)
apply(sep_auto dest!: mod_starD)
using assms apply (auto dest!: list_assn_len)[]
using assms apply(sep_auto split!: prod.splits)
using assms apply (auto simp del: height_btree.simps dest!: mod_starD list_assn_len)[]
using z_split apply(auto)[]
subgoal for _ _ _ _ _ _ _ _ tp tsia' tsin' _ _ _ _ _ _ _ _ _ _ tsia tsin tti ttsi sepi subp
apply(auto dest!: mod_starD list_assn_len simp: prod_assn_def)[]
apply(vcg)
apply(auto)[]
apply(rule ent_ex_postI[where x="lsi@(Some subp, sepi)#rsi"])
apply(rule ent_ex_postI[where x="(tsia, tsin)"])
apply(rule ent_ex_postI[where x="tti"])
apply(rule ent_ex_postI[where x=ttsi])
apply(sep_auto)[]
apply(rule hoare_triple_preI)
using True apply(auto dest!: mod_starD list_assn_len)
done
done
next
case False
then show ?thesis
proof(cases rs)
case Nil
then show ?thesis
apply(subst rebalance_middle_tree_def)
apply(rule hoare_triple_preI)
apply(sep_auto dest!: mod_starD)
using assms apply (auto dest!: list_assn_len)[]
apply(sep_auto split!: prod.splits)
using assms apply (auto simp del: height_btree.simps dest!: mod_starD list_assn_len)[]
using z_split apply(auto)[]
subgoal for _ _ _ _ _ _ _ _ tp tsia' tsin' _ _ _ _ _ _ _ _ _ _ tsia tsin tti ttsi
apply(auto dest!: mod_starD list_assn_len simp: prod_assn_def)[]
apply(vcg)
using False apply(auto dest!: mod_starD list_assn_len)
done
apply(sep_auto dest!: mod_starD)
using assms apply (auto dest!: list_assn_len)[]
using assms apply (auto dest!: list_assn_len)[]
apply(sep_auto)
using assms apply (auto dest!: list_assn_len mod_starD)[]
using assms apply (auto dest!: list_assn_len mod_starD)[]
(* Issue: we do not know yet what 'subp is pointing at *)
subgoal for _ _ _ _ _ _ tp tsia tsin tti ttsi _ _ _ _ _ _ _ _ tsia' tsin' tti' tsi' subi sepi subp
apply(subgoal_tac "z = (subi, sepi)")
prefer 2
apply (metis assms(3) list_assn_len nth_append_length)
apply simp
apply(vcg)
subgoal
(* still the "IF" branch *)
apply(rule entailsI)
(* solves impossible case*)
using False apply (auto dest!: list_assn_len mod_starD)[]
done
apply (auto del: impCE)
apply(thin_tac "_ \<Turnstile> _")+
apply(rule hoare_triple_preI)
(* for each possible combination of \<le> and \<not>\<le>, a subgoal is created *)
apply(sep_auto heap add: node\<^sub>i_rule_ins dest!: mod_starD del: impCE)
apply (auto dest!: pfa_assn_len)[]
apply (auto dest!: pfa_assn_len list_assn_len)[]
subgoal
apply(thin_tac "_ \<Turnstile> _")+
apply(rule hoare_triple_preI)
apply(sep_auto split!: btupi.splits del: impCE)
apply(auto dest!: btupi_assn_T mod_starD del: impCE)[]
apply(rule ent_ex_postI[where x="lsi"])
apply sep_auto
apply (sep_auto del: impCE)
apply(auto dest!: btupi_assn_Up mod_starD split!: list.splits del: impCE)[]
subgoal for li ai ri
apply(rule ent_ex_postI[where x="lsi @ [(li, ai)]"])
apply sep_auto
done
done
apply (sep_auto del: impCE)
using assms apply(auto dest!: pfa_assn_len list_assn_len mod_starD)[]
using assms apply(auto dest!: pfa_assn_len list_assn_len mod_starD)[]
done
done
next
case (Cons rss rrs)
then show ?thesis
apply(subst rebalance_middle_tree_def)
apply(rule hoare_triple_preI)
apply(sep_auto dest!: mod_starD)
using assms apply (auto dest!: list_assn_len)[]
apply(sep_auto split!: prod.splits)
using assms apply (auto simp del: height_btree.simps dest!: mod_starD list_assn_len)[]
apply(auto)[]
subgoal for _ _ _ _ _ _ _ _ tp tsia' tsin' _ _ _ _ _ _ _ _ _ _ tsia tsin tti ttsi
apply(auto dest!: mod_starD list_assn_len simp: prod_assn_def)[]
apply(vcg)
using False apply(auto dest!: mod_starD list_assn_len)
done
apply(sep_auto dest!: mod_starD del: impCE)
using assms apply (auto dest!: list_assn_len)[]
apply(sep_auto del: impCE)
using assms apply (auto dest!: list_assn_len mod_starD)[]
(* Issue: we do not know yet what 'xa' is pointing at *)
subgoal for list_heap1 list_heap2 _ _ _ _ _ _ tp ttsia' ttsin' tti' ttsi' _ _ _ _ _ _ _ _ ttsia ttsin tti ttsi subi sepi subp
apply(subgoal_tac "z = (subi, sepi)")
prefer 2
apply (metis assms(3) list_assn_len nth_append_length)
apply simp
apply(vcg)
subgoal
(* still the "IF" branch *)
apply(rule entailsI)
(* solves impossible case*)
using False apply (auto dest!: list_assn_len mod_starD)[]
done
apply simp
subgoal for subtsi subti subts ti subi subtsl ttsl
(* TODO different nodei rule here *)
supply R = node\<^sub>i_rule_ins[where k=k and c="(max (2 * k) (Suc (_ + ttsin)))" and lsi=subts]
thm R
apply(cases subtsi)
apply(sep_auto heap add: R pfa_append_extend_grow_rule dest!: mod_starD del: impCE)
(* all of these cases are vacuous *)
using assms apply (auto dest!: list_assn_len pfa_assn_len)[]
using assms apply (auto dest!: list_assn_len pfa_assn_len)[]
using assms apply (auto dest!: list_assn_len pfa_assn_len)[]
apply(sep_auto split!: btupi.splits del: impCE)
using assms apply (auto dest!: list_assn_len pfa_assn_len)[]
apply(thin_tac "_ \<Turnstile> _")+
apply(rule hoare_triple_preI)
apply (cases rsi)
apply(auto dest!: list_assn_len mod_starD)[]
(* TODO avoid creating subgoals here but still split the heap? do we need to do that anyways *)
subgoal for subtsa subtsn mtsa mtsn mtt mtsi _ _ _ _ _ _ _ _ rsubsep _ rrsi rssi
(* ensuring that the tree to the right is not none *)
apply (cases rsubsep)
apply(subgoal_tac "rsubsep = rrsi")
prefer 2
using assms apply(auto dest!: list_assn_len mod_starD del: impCE simp add: second_last_access)[]
apply (simp add: prod_assn_def)
apply(cases rss)
apply simp
subgoal for rsubi rsepi rsub rsep
apply(subgoal_tac "height rsub \<noteq> 0")
prefer 2
using assms apply(auto)[]
apply(cases rsubi; cases rsub)
apply simp+
(* now we may proceed *)
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
subgoal for rsubi rsubts rsubt rsubtsi' rsubti rsubtsi subnode
apply(cases "kvs subnode")
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
subgoal for _ rsubtsn subtsmergedi
apply (cases subtsmergedi)
apply simp
apply (vcg (ss))
subgoal for subtsmergeda _
supply R = node\<^sub>i_rule_ins[where
k=k and
c="max (2*k) (Suc (subtsn + rsubtsn))" and
ls="mts" and
al="Suc (subtsn+rsubtsn)" and
aa=subtsmergeda and
ti=rsubti and
rsi=rsubtsi and
li=subti and a=sep and ai=sep
]
thm R
apply(rule P_imp_Q_implies_P)
apply(auto del: impCE dest!: mod_starD list_assn_len)[]
apply(rule hoare_triple_preI)
apply(subgoal_tac "subtsn \<le> 2*k \<and> rsubtsn \<le> 2*k")
prefer 2
apply (auto simp add: is_pfa_def)[]
apply (sep_auto heap add: R del: impCE)
apply(sep_auto split!: btupi.splits del: impCE)
using assms apply(auto dest!: mod_starD list_assn_len)[]
apply(sep_auto del: impCE)
using assms apply(auto dest!: mod_starD list_assn_len pfa_assn_len del: impCE)[]
apply(thin_tac "_ \<Turnstile> _")+
apply(rule hoare_triple_preI)
apply (drule btupi_assn_T mod_starD | erule conjE exE)+
apply vcg
apply simp
subgoal for rsubtsi ai tsian
apply(cases tsian)
apply simp
apply(rule P_imp_Q_implies_P)
apply(rule ent_ex_postI[where x="lsi @ (ai, rsep) # rssi"])
apply(rule ent_ex_postI[where x="(ttsia, ttsin)"])
apply(rule ent_ex_postI[where x="tti"])
apply(rule ent_ex_postI[where x="ttsi"])
using assms apply (sep_auto dest!: list_assn_len)
done
subgoal for _ _ rsubp rsubtsa _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ li ai ri
apply(sep_auto del: impCE)
using assms apply(auto dest!: list_assn_len)[]
apply(sep_auto del: impCE)
using assms apply(auto dest!: list_assn_len)[]
apply(thin_tac "_ \<Turnstile> _")+
apply(rule hoare_triple_preI)
apply (drule btupi_assn_Up mod_starD | erule conjE exE)+
apply vcg
(* generates two identical subgoals ? *)
apply(simp split!: list.split)
apply(rule ent_ex_postI[where x="(lsi @ (li, ai) # (ri, rsepi) # rssi)"])
apply(rule ent_ex_postI[where x="(ttsia, ttsin)"])
apply(rule ent_ex_postI[where x="tti"])
apply(rule ent_ex_postI[where x="ttsi"])
using assms apply (sep_auto dest!: list_assn_len)
apply(rule ent_ex_postI[where x="(lsi @ (li, ai) # (ri, rsepi) # rssi)"])
apply(rule ent_ex_postI[where x="(ttsia, ttsin)"])
apply(rule ent_ex_postI[where x="tti"])
apply(rule ent_ex_postI[where x="ttsi"])
using assms apply (sep_auto dest!: list_assn_len)
done
done
done
done
done
done
done
done
done
qed
qed
qed
qed
qed
lemma rebalance_last_tree_rule:
assumes "height t = height sub"
and "ts = list@[(sub,sep)]"
shows "<is_pfa (2*k) tsi tsia * blist_assn k ts tsi * btree_assn k t ti>
rebalance_last_tree k tsia ti
<\<lambda>r. btnode_assn k (abs_split.rebalance_last_tree k ts t) r >\<^sub>t"
apply(subst rebalance_last_tree_def)
apply(rule hoare_triple_preI)
using assms apply(auto dest!: mod_starD)
apply(subgoal_tac "length tsi - Suc 0 = length list")
prefer 2
apply(auto dest!: list_assn_len)[]
using assms apply(sep_auto)
supply R = rebalance_middle_tree_rule[where
ls="list" and
rs="[]" and
i="length tsi - 1", simplified]
apply(cases tsia)
using R by blast
partial_function (heap) split_max ::"nat \<Rightarrow> ('a::{default,heap,linorder}) btnode ref option \<Rightarrow> ('a btnode ref option \<times> 'a) Heap"
where
"split_max k r_t = (case r_t of Some p_t \<Rightarrow> do {
t \<leftarrow> !p_t;
(case (last t) of None \<Rightarrow> do {
(sub,sep) \<leftarrow> pfa_last (kvs t);
tsi' \<leftarrow> pfa_butlast (kvs t);
p_t := Btnode tsi' sub;
return (Some p_t, sep)
} |
Some x \<Rightarrow> do {
(sub,sep) \<leftarrow> split_max k (Some x);
p_t' \<leftarrow> rebalance_last_tree k (kvs t) sub;
p_t := p_t';
return (Some p_t, sep)
})
})
"
declare abs_split.split_max.simps [simp del] abs_split.rebalance_last_tree.simps [simp del] height_btree.simps [simp del]
lemma split_max_rule:
assumes "abs_split.nonempty_lasttreebal t"
and "t \<noteq> Leaf"
shows "<btree_assn k t ti>
split_max k ti
<((btree_assn k) \<times>\<^sub>a id_assn) (abs_split.split_max k t)>\<^sub>t"
using assms
proof(induction k t arbitrary: ti rule: abs_split.split_max.induct)
case (2 Leaf)
then show ?case by auto
next
case (1 k ts tt)
then show ?case
proof(cases tt)
case Leaf
then show ?thesis
apply(subst split_max.simps)
apply (vcg)
using assms apply auto[]
apply (vcg (ss))
apply simp
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply(rule hoare_triple_preI)
apply (vcg (ss))
using 1 apply(auto dest!: mod_starD)[]
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))
apply (vcg (ss))