summaryrefslogtreecommitdiff
path: root/tests/lean/betree/BetreeMain
diff options
context:
space:
mode:
authorSon Ho2023-03-07 23:50:36 +0100
committerSon HO2023-06-04 21:44:33 +0200
commitca77353c20e425c687ba207023d56828de6495b6 (patch)
tree4a800459fb5ec27dcfb1f20e4d5d0d785bb07959 /tests/lean/betree/BetreeMain
parentfa76f1b94e1f68d520b02c0dc1072cb73fa9d8be (diff)
Start updating simplify_aggregates
Diffstat (limited to '')
-rw-r--r--tests/lean/betree/BetreeMain/Funs.lean227
1 files changed, 99 insertions, 128 deletions
diff --git a/tests/lean/betree/BetreeMain/Funs.lean b/tests/lean/betree/BetreeMain/Funs.lean
index e40ca4ca..5d355677 100644
--- a/tests/lean/betree/BetreeMain/Funs.lean
+++ b/tests/lean/betree/BetreeMain/Funs.lean
@@ -223,13 +223,7 @@ def betree_leaf_split_fwd
betree_leaf_id := id1,
betree_leaf_size := params.betree_params_split_size
}
- Result.ret (st1,
- {
- betree_internal_id := self.betree_leaf_id,
- betree_internal_pivot := pivot,
- betree_internal_left := n,
- betree_internal_right := n0
- })
+ Result.ret (st1, mkbetree_internal_t self.betree_leaf_id pivot n n0)
/- [betree_main::betree::Leaf::{3}::split] -/
def betree_leaf_split_back
@@ -380,8 +374,8 @@ mutual def betree_node_lookup_fwd
match h: self with
| betree_node_t.BetreeNodeInternal node =>
do
- let (st0, msgs) ←
- betree_load_internal_node_fwd node.betree_internal_id st
+ let (mkbetree_internal_t i i0 n n0) := node
+ let (st0, msgs) ← betree_load_internal_node_fwd i st
let pending ← betree_node_lookup_first_message_for_key_fwd key msgs
match h: pending with
| betree_list_t.BetreeListCons p l =>
@@ -390,7 +384,8 @@ mutual def betree_node_lookup_fwd
then
do
let (st1, opt) ←
- betree_internal_lookup_in_children_fwd node key st0
+ betree_internal_lookup_in_children_fwd (mkbetree_internal_t i i0
+ n n0) key st0
let _ ←
betree_node_lookup_first_message_for_key_back key msgs
(betree_list_t.BetreeListCons (k, msg) l)
@@ -414,25 +409,27 @@ mutual def betree_node_lookup_fwd
| betree_message_t.BetreeMessageUpsert ufs =>
do
let (st1, v) ←
- betree_internal_lookup_in_children_fwd node key st0
+ betree_internal_lookup_in_children_fwd (mkbetree_internal_t i
+ i0 n n0) key st0
let (st2, v0) ←
betree_node_apply_upserts_fwd (betree_list_t.BetreeListCons (k,
betree_message_t.BetreeMessageUpsert ufs) l) v key st1
let node0 ←
- betree_internal_lookup_in_children_back node key st0
+ betree_internal_lookup_in_children_back (mkbetree_internal_t i
+ i0 n n0) key st0
+ let (mkbetree_internal_t i1 _ _ _) := node0
let pending0 ←
betree_node_apply_upserts_back (betree_list_t.BetreeListCons
(k, betree_message_t.BetreeMessageUpsert ufs) l) v key st1
let msgs0 ←
betree_node_lookup_first_message_for_key_back key msgs pending0
- let (st3, _) ←
- betree_store_internal_node_fwd node0.betree_internal_id msgs0
- st2
+ let (st3, _) ← betree_store_internal_node_fwd i1 msgs0 st2
Result.ret (st3, Option.some v0)
| betree_list_t.BetreeListNil =>
do
let (st1, opt) ←
- betree_internal_lookup_in_children_fwd node key st0
+ betree_internal_lookup_in_children_fwd (mkbetree_internal_t i i0 n
+ n0) key st0
let _ ←
betree_node_lookup_first_message_for_key_back key msgs
betree_list_t.BetreeListNil
@@ -454,8 +451,8 @@ def betree_node_lookup_back
match h: self with
| betree_node_t.BetreeNodeInternal node =>
do
- let (st0, msgs) ←
- betree_load_internal_node_fwd node.betree_internal_id st
+ let (mkbetree_internal_t i i0 n n0) := node
+ let (st0, msgs) ← betree_load_internal_node_fwd i st
let pending ← betree_node_lookup_first_message_for_key_fwd key msgs
match h: pending with
| betree_list_t.BetreeListCons p l =>
@@ -466,7 +463,9 @@ def betree_node_lookup_back
let _ ←
betree_node_lookup_first_message_for_key_back key msgs
(betree_list_t.BetreeListCons (k, msg) l)
- let node0 ← betree_internal_lookup_in_children_back node key st0
+ let node0 ←
+ betree_internal_lookup_in_children_back (mkbetree_internal_t i i0
+ n n0) key st0
Result.ret (betree_node_t.BetreeNodeInternal node0)
else
match h: msg with
@@ -476,38 +475,44 @@ def betree_node_lookup_back
betree_node_lookup_first_message_for_key_back key msgs
(betree_list_t.BetreeListCons (k,
betree_message_t.BetreeMessageInsert v) l)
- Result.ret (betree_node_t.BetreeNodeInternal node)
+ Result.ret (betree_node_t.BetreeNodeInternal (mkbetree_internal_t
+ i i0 n n0))
| betree_message_t.BetreeMessageDelete =>
do
let _ ←
betree_node_lookup_first_message_for_key_back key msgs
(betree_list_t.BetreeListCons (k,
betree_message_t.BetreeMessageDelete) l)
- Result.ret (betree_node_t.BetreeNodeInternal node)
+ Result.ret (betree_node_t.BetreeNodeInternal (mkbetree_internal_t
+ i i0 n n0))
| betree_message_t.BetreeMessageUpsert ufs =>
do
let (st1, v) ←
- betree_internal_lookup_in_children_fwd node key st0
+ betree_internal_lookup_in_children_fwd (mkbetree_internal_t i
+ i0 n n0) key st0
let (st2, _) ←
betree_node_apply_upserts_fwd (betree_list_t.BetreeListCons (k,
betree_message_t.BetreeMessageUpsert ufs) l) v key st1
let node0 ←
- betree_internal_lookup_in_children_back node key st0
+ betree_internal_lookup_in_children_back (mkbetree_internal_t i
+ i0 n n0) key st0
+ let (mkbetree_internal_t i1 i2 n1 n2) := node0
let pending0 ←
betree_node_apply_upserts_back (betree_list_t.BetreeListCons
(k, betree_message_t.BetreeMessageUpsert ufs) l) v key st1
let msgs0 ←
betree_node_lookup_first_message_for_key_back key msgs pending0
- let _ ←
- betree_store_internal_node_fwd node0.betree_internal_id msgs0
- st2
- Result.ret (betree_node_t.BetreeNodeInternal node0)
+ let _ ← betree_store_internal_node_fwd i1 msgs0 st2
+ Result.ret (betree_node_t.BetreeNodeInternal (mkbetree_internal_t
+ i1 i2 n1 n2))
| betree_list_t.BetreeListNil =>
do
let _ ←
betree_node_lookup_first_message_for_key_back key msgs
betree_list_t.BetreeListNil
- let node0 ← betree_internal_lookup_in_children_back node key st0
+ let node0 ←
+ betree_internal_lookup_in_children_back (mkbetree_internal_t i i0 n
+ n0) key st0
Result.ret (betree_node_t.BetreeNodeInternal node0)
| betree_node_t.BetreeNodeLeaf node =>
do
@@ -523,9 +528,10 @@ def betree_internal_lookup_in_children_fwd
(self : betree_internal_t) (key : UInt64) (st : State) :
(Result (State × (Option UInt64)))
:=
- if h: key < self.betree_internal_pivot
- then betree_node_lookup_fwd self.betree_internal_left key st
- else betree_node_lookup_fwd self.betree_internal_right key st
+ let (mkbetree_internal_t _ i n n0) := self
+ if h: key < i
+ then betree_node_lookup_fwd n key st
+ else betree_node_lookup_fwd n0 key st
termination_by betree_internal_lookup_in_children_fwd self key st =>
betree_internal_lookup_in_children_terminates self key st
decreasing_by betree_internal_lookup_in_children_decreases self key st
@@ -535,27 +541,16 @@ def betree_internal_lookup_in_children_back
(self : betree_internal_t) (key : UInt64) (st : State) :
(Result betree_internal_t)
:=
- if h: key < self.betree_internal_pivot
+ let (mkbetree_internal_t i i0 n n0) := self
+ if h: key < i0
then
do
- let n ← betree_node_lookup_back self.betree_internal_left key st
- Result.ret
- {
- betree_internal_id := self.betree_internal_id,
- betree_internal_pivot := self.betree_internal_pivot,
- betree_internal_left := n,
- betree_internal_right := self.betree_internal_right
- }
+ let n1 ← betree_node_lookup_back n key st
+ Result.ret (mkbetree_internal_t i i0 n1 n0)
else
do
- let n ← betree_node_lookup_back self.betree_internal_right key st
- Result.ret
- {
- betree_internal_id := self.betree_internal_id,
- betree_internal_pivot := self.betree_internal_pivot,
- betree_internal_left := self.betree_internal_left,
- betree_internal_right := n
- }
+ let n1 ← betree_node_lookup_back n0 key st
+ Result.ret (mkbetree_internal_t i i0 n n1)
termination_by betree_internal_lookup_in_children_back self key st =>
betree_internal_lookup_in_children_terminates self key st
decreasing_by betree_internal_lookup_in_children_decreases self key st
@@ -819,8 +814,8 @@ mutual def betree_node_apply_messages_fwd
match h: self with
| betree_node_t.BetreeNodeInternal node =>
do
- let (st0, content) ←
- betree_load_internal_node_fwd node.betree_internal_id st
+ let (mkbetree_internal_t i i0 n n0) := node
+ let (st0, content) ← betree_load_internal_node_fwd i st
let content0 ←
betree_node_apply_messages_to_internal_fwd_back content msgs
let num_msgs ←
@@ -829,17 +824,17 @@ mutual def betree_node_apply_messages_fwd
then
do
let (st1, content1) ←
- betree_internal_flush_fwd node params node_id_cnt content0 st0
+ betree_internal_flush_fwd (mkbetree_internal_t i i0 n n0) params
+ node_id_cnt content0 st0
let (node0, _) ←
- betree_internal_flush_back node params node_id_cnt content0 st0
- let (st2, _) ←
- betree_store_internal_node_fwd node0.betree_internal_id content1
- st1
+ betree_internal_flush_back (mkbetree_internal_t i i0 n n0) params
+ node_id_cnt content0 st0
+ let (mkbetree_internal_t i1 _ _ _) := node0
+ let (st2, _) ← betree_store_internal_node_fwd i1 content1 st1
Result.ret (st2, ())
else
do
- let (st1, _) ←
- betree_store_internal_node_fwd node.betree_internal_id content0 st0
+ let (st1, _) ← betree_store_internal_node_fwd i content0 st0
Result.ret (st1, ())
| betree_node_t.BetreeNodeLeaf node =>
do
@@ -878,8 +873,8 @@ def betree_node_apply_messages_back
match h: self with
| betree_node_t.BetreeNodeInternal node =>
do
- let (st0, content) ←
- betree_load_internal_node_fwd node.betree_internal_id st
+ let (mkbetree_internal_t i i0 n n0) := node
+ let (st0, content) ← betree_load_internal_node_fwd i st
let content0 ←
betree_node_apply_messages_to_internal_fwd_back content msgs
let num_msgs ←
@@ -888,18 +883,20 @@ def betree_node_apply_messages_back
then
do
let (st1, content1) ←
- betree_internal_flush_fwd node params node_id_cnt content0 st0
+ betree_internal_flush_fwd (mkbetree_internal_t i i0 n n0) params
+ node_id_cnt content0 st0
let (node0, node_id_cnt0) ←
- betree_internal_flush_back node params node_id_cnt content0 st0
- let _ ←
- betree_store_internal_node_fwd node0.betree_internal_id content1
- st1
- Result.ret (betree_node_t.BetreeNodeInternal node0, node_id_cnt0)
+ betree_internal_flush_back (mkbetree_internal_t i i0 n n0) params
+ node_id_cnt content0 st0
+ let (mkbetree_internal_t i1 i2 n1 n2) := node0
+ let _ ← betree_store_internal_node_fwd i1 content1 st1
+ Result.ret (betree_node_t.BetreeNodeInternal (mkbetree_internal_t i1
+ i2 n1 n2), node_id_cnt0)
else
do
- let _ ←
- betree_store_internal_node_fwd node.betree_internal_id content0 st0
- Result.ret (betree_node_t.BetreeNodeInternal node, node_id_cnt)
+ let _ ← betree_store_internal_node_fwd i content0 st0
+ Result.ret (betree_node_t.BetreeNodeInternal (mkbetree_internal_t i
+ i0 n n0), node_id_cnt)
| betree_node_t.BetreeNodeLeaf node =>
do
let (st0, content) ← betree_load_leaf_node_fwd node.betree_leaf_id st
@@ -938,41 +935,36 @@ def betree_internal_flush_fwd
(Result (State × (betree_list_t (UInt64 × betree_message_t))))
:=
do
- let p ←
- betree_list_partition_at_pivot_fwd betree_message_t content
- self.betree_internal_pivot
+ let (mkbetree_internal_t _ i n n0) := self
+ let p ← betree_list_partition_at_pivot_fwd betree_message_t content i
let (msgs_left, msgs_right) := p
let len_left ← betree_list_len_fwd (UInt64 × betree_message_t) msgs_left
if h: len_left >= params.betree_params_min_flush_size
then
do
let (st0, _) ←
- betree_node_apply_messages_fwd self.betree_internal_left params
- node_id_cnt msgs_left st
+ betree_node_apply_messages_fwd n params node_id_cnt msgs_left st
let (_, node_id_cnt0) ←
- betree_node_apply_messages_back self.betree_internal_left params
- node_id_cnt msgs_left st
+ betree_node_apply_messages_back n params node_id_cnt msgs_left st
let len_right ←
betree_list_len_fwd (UInt64 × betree_message_t) msgs_right
if h: len_right >= params.betree_params_min_flush_size
then
do
let (st1, _) ←
- betree_node_apply_messages_fwd self.betree_internal_right params
- node_id_cnt0 msgs_right st0
+ betree_node_apply_messages_fwd n0 params node_id_cnt0 msgs_right
+ st0
let _ ←
- betree_node_apply_messages_back self.betree_internal_right params
- node_id_cnt0 msgs_right st0
+ betree_node_apply_messages_back n0 params node_id_cnt0 msgs_right
+ st0
Result.ret (st1, betree_list_t.BetreeListNil)
else Result.ret (st0, msgs_right)
else
do
let (st0, _) ←
- betree_node_apply_messages_fwd self.betree_internal_right params
- node_id_cnt msgs_right st
+ betree_node_apply_messages_fwd n0 params node_id_cnt msgs_right st
let _ ←
- betree_node_apply_messages_back self.betree_internal_right params
- node_id_cnt msgs_right st
+ betree_node_apply_messages_back n0 params node_id_cnt msgs_right st
Result.ret (st0, msgs_left)
termination_by betree_internal_flush_fwd self params node_id_cnt content st =>
betree_internal_flush_terminates self params node_id_cnt content st
@@ -987,55 +979,32 @@ def betree_internal_flush_back
(Result (betree_internal_t × betree_node_id_counter_t))
:=
do
- let p ←
- betree_list_partition_at_pivot_fwd betree_message_t content
- self.betree_internal_pivot
+ let (mkbetree_internal_t i i0 n n0) := self
+ let p ← betree_list_partition_at_pivot_fwd betree_message_t content i0
let (msgs_left, msgs_right) := p
let len_left ← betree_list_len_fwd (UInt64 × betree_message_t) msgs_left
if h: len_left >= params.betree_params_min_flush_size
then
do
let (st0, _) ←
- betree_node_apply_messages_fwd self.betree_internal_left params
- node_id_cnt msgs_left st
- let (n, node_id_cnt0) ←
- betree_node_apply_messages_back self.betree_internal_left params
- node_id_cnt msgs_left st
+ betree_node_apply_messages_fwd n params node_id_cnt msgs_left st
+ let (n1, node_id_cnt0) ←
+ betree_node_apply_messages_back n params node_id_cnt msgs_left st
let len_right ←
betree_list_len_fwd (UInt64 × betree_message_t) msgs_right
if h: len_right >= params.betree_params_min_flush_size
then
do
- let (n0, node_id_cnt1) ←
- betree_node_apply_messages_back self.betree_internal_right params
- node_id_cnt0 msgs_right st0
- Result.ret
- ({
- betree_internal_id := self.betree_internal_id,
- betree_internal_pivot := self.betree_internal_pivot,
- betree_internal_left := n,
- betree_internal_right := n0
- }, node_id_cnt1)
- else
- Result.ret
- ({
- betree_internal_id := self.betree_internal_id,
- betree_internal_pivot := self.betree_internal_pivot,
- betree_internal_left := n,
- betree_internal_right := self.betree_internal_right
- }, node_id_cnt0)
+ let (n2, node_id_cnt1) ←
+ betree_node_apply_messages_back n0 params node_id_cnt0 msgs_right
+ st0
+ Result.ret (mkbetree_internal_t i i0 n1 n2, node_id_cnt1)
+ else Result.ret (mkbetree_internal_t i i0 n1 n0, node_id_cnt0)
else
do
- let (n, node_id_cnt0) ←
- betree_node_apply_messages_back self.betree_internal_right params
- node_id_cnt msgs_right st
- Result.ret
- ({
- betree_internal_id := self.betree_internal_id,
- betree_internal_pivot := self.betree_internal_pivot,
- betree_internal_left := self.betree_internal_left,
- betree_internal_right := n
- }, node_id_cnt0)
+ let (n1, node_id_cnt0) ←
+ betree_node_apply_messages_back n0 params node_id_cnt msgs_right st
+ Result.ret (mkbetree_internal_t i i0 n n1, node_id_cnt0)
termination_by betree_internal_flush_back self params node_id_cnt content st =>
betree_internal_flush_terminates self params node_id_cnt content st
decreasing_by
@@ -1082,16 +1051,18 @@ def betree_be_tree_new_fwd
let node_id_cnt0 ← betree_node_id_counter_fresh_id_back node_id_cnt
Result.ret (st0,
{
- betree_be_tree_params := {
- betree_params_min_flush_size := min_flush_size,
- betree_params_split_size := split_size
- },
+ betree_be_tree_params :=
+ {
+ betree_params_min_flush_size := min_flush_size,
+ betree_params_split_size := split_size
+ },
betree_be_tree_node_id_cnt := node_id_cnt0,
- betree_be_tree_root := (betree_node_t.BetreeNodeLeaf
- {
- betree_leaf_id := id,
- betree_leaf_size := (UInt64.ofNatCore 0 (by intlit))
- })
+ betree_be_tree_root :=
+ (betree_node_t.BetreeNodeLeaf
+ {
+ betree_leaf_id := id,
+ betree_leaf_size := (UInt64.ofNatCore 0 (by intlit))
+ })
})
/- [betree_main::betree::BeTree::{6}::apply] -/