diff options
author | Son HO | 2023-12-23 01:46:58 +0100 |
---|---|---|
committer | GitHub | 2023-12-23 01:46:58 +0100 |
commit | 15a7d7b7322a1cd0ebeb328fde214060e23fa8b4 (patch) | |
tree | 6cce7d76969870f5bc18c5a7cd585e8873a1c0dc /tests/fstar-split/betree/BetreeMain.Funs.fst | |
parent | c3e0b90e422cbd902ee6d2b47073940c0017b7fb (diff) | |
parent | 63ccbd914d5d44aa30dee38a6fcc019310ab640b (diff) |
Merge pull request #64 from AeneasVerif/son/merge_back
Merge the forward/backward functions
Diffstat (limited to 'tests/fstar-split/betree/BetreeMain.Funs.fst')
-rw-r--r-- | tests/fstar-split/betree/BetreeMain.Funs.fst | 1006 |
1 files changed, 1006 insertions, 0 deletions
diff --git a/tests/fstar-split/betree/BetreeMain.Funs.fst b/tests/fstar-split/betree/BetreeMain.Funs.fst new file mode 100644 index 00000000..33133236 --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.Funs.fst @@ -0,0 +1,1006 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [betree_main]: function definitions *) +module BetreeMain.Funs +open Primitives +include BetreeMain.Types +include BetreeMain.FunsExternal +include BetreeMain.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [betree_main::betree::load_internal_node]: forward function + Source: 'src/betree.rs', lines 36:0-36:52 *) +let betree_load_internal_node + (id : u64) (st : state) : + result (state & (betree_List_t (u64 & betree_Message_t))) + = + betree_utils_load_internal_node id st + +(** [betree_main::betree::store_internal_node]: forward function + Source: 'src/betree.rs', lines 41:0-41:60 *) +let betree_store_internal_node + (id : u64) (content : betree_List_t (u64 & betree_Message_t)) (st : state) : + result (state & unit) + = + let* (st1, _) = betree_utils_store_internal_node id content st in + Return (st1, ()) + +(** [betree_main::betree::load_leaf_node]: forward function + Source: 'src/betree.rs', lines 46:0-46:44 *) +let betree_load_leaf_node + (id : u64) (st : state) : result (state & (betree_List_t (u64 & u64))) = + betree_utils_load_leaf_node id st + +(** [betree_main::betree::store_leaf_node]: forward function + Source: 'src/betree.rs', lines 51:0-51:52 *) +let betree_store_leaf_node + (id : u64) (content : betree_List_t (u64 & u64)) (st : state) : + result (state & unit) + = + let* (st1, _) = betree_utils_store_leaf_node id content st in + Return (st1, ()) + +(** [betree_main::betree::fresh_node_id]: forward function + Source: 'src/betree.rs', lines 55:0-55:48 *) +let betree_fresh_node_id (counter : u64) : result u64 = + let* _ = u64_add counter 1 in Return counter + +(** [betree_main::betree::fresh_node_id]: backward function 0 + Source: 'src/betree.rs', lines 55:0-55:48 *) +let betree_fresh_node_id_back (counter : u64) : result u64 = + u64_add counter 1 + +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: forward function + Source: 'src/betree.rs', lines 206:4-206:20 *) +let betree_NodeIdCounter_new : result betree_NodeIdCounter_t = + Return { next_node_id = 0 } + +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: forward function + Source: 'src/betree.rs', lines 210:4-210:36 *) +let betree_NodeIdCounter_fresh_id + (self : betree_NodeIdCounter_t) : result u64 = + let* _ = u64_add self.next_node_id 1 in Return self.next_node_id + +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: backward function 0 + Source: 'src/betree.rs', lines 210:4-210:36 *) +let betree_NodeIdCounter_fresh_id_back + (self : betree_NodeIdCounter_t) : result betree_NodeIdCounter_t = + let* i = u64_add self.next_node_id 1 in Return { next_node_id = i } + +(** [betree_main::betree::upsert_update]: forward function + Source: 'src/betree.rs', lines 234:0-234:70 *) +let betree_upsert_update + (prev : option u64) (st : betree_UpsertFunState_t) : result u64 = + begin match prev with + | None -> + begin match st with + | Betree_UpsertFunState_Add v -> Return v + | Betree_UpsertFunState_Sub _ -> Return 0 + end + | Some prev1 -> + begin match st with + | Betree_UpsertFunState_Add v -> + let* margin = u64_sub core_u64_max prev1 in + if margin >= v then u64_add prev1 v else Return core_u64_max + | Betree_UpsertFunState_Sub v -> + if prev1 >= v then u64_sub prev1 v else Return 0 + end + end + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::len]: forward function + Source: 'src/betree.rs', lines 276:4-276:24 *) +let rec betree_List_len + (t : Type0) (self : betree_List_t t) : + Tot (result u64) (decreases (betree_List_len_decreases t self)) + = + begin match self with + | Betree_List_Cons _ tl -> let* i = betree_List_len t tl in u64_add 1 i + | Betree_List_Nil -> Return 0 + end + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::split_at]: forward function + Source: 'src/betree.rs', lines 284:4-284:51 *) +let rec betree_List_split_at + (t : Type0) (self : betree_List_t t) (n : u64) : + Tot (result ((betree_List_t t) & (betree_List_t t))) + (decreases (betree_List_split_at_decreases t self n)) + = + if n = 0 + then Return (Betree_List_Nil, self) + else + begin match self with + | Betree_List_Cons hd tl -> + let* i = u64_sub n 1 in + let* p = betree_List_split_at t tl i in + let (ls0, ls1) = p in + Return (Betree_List_Cons hd ls0, ls1) + | Betree_List_Nil -> Fail Failure + end + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::push_front]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 299:4-299:34 *) +let betree_List_push_front + (t : Type0) (self : betree_List_t t) (x : t) : result (betree_List_t t) = + let tl = core_mem_replace (betree_List_t t) self Betree_List_Nil in + Return (Betree_List_Cons x tl) + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::pop_front]: forward function + Source: 'src/betree.rs', lines 306:4-306:32 *) +let betree_List_pop_front (t : Type0) (self : betree_List_t t) : result t = + let ls = core_mem_replace (betree_List_t t) self Betree_List_Nil in + begin match ls with + | Betree_List_Cons x _ -> Return x + | Betree_List_Nil -> Fail Failure + end + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::pop_front]: backward function 0 + Source: 'src/betree.rs', lines 306:4-306:32 *) +let betree_List_pop_front_back + (t : Type0) (self : betree_List_t t) : result (betree_List_t t) = + let ls = core_mem_replace (betree_List_t t) self Betree_List_Nil in + begin match ls with + | Betree_List_Cons _ tl -> Return tl + | Betree_List_Nil -> Fail Failure + end + +(** [betree_main::betree::{betree_main::betree::List<T>#1}::hd]: forward function + Source: 'src/betree.rs', lines 318:4-318:22 *) +let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = + begin match self with + | Betree_List_Cons hd _ -> Return hd + | Betree_List_Nil -> Fail Failure + end + +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: forward function + Source: 'src/betree.rs', lines 327:4-327:44 *) +let betree_ListTupleU64T_head_has_key + (t : Type0) (self : betree_List_t (u64 & t)) (key : u64) : result bool = + begin match self with + | Betree_List_Cons hd _ -> let (i, _) = hd in Return (i = key) + | Betree_List_Nil -> Return false + end + +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: forward function + Source: 'src/betree.rs', lines 339:4-339:73 *) +let rec betree_ListTupleU64T_partition_at_pivot + (t : Type0) (self : betree_List_t (u64 & t)) (pivot : u64) : + Tot (result ((betree_List_t (u64 & t)) & (betree_List_t (u64 & t)))) + (decreases (betree_ListTupleU64T_partition_at_pivot_decreases t self pivot)) + = + begin match self with + | Betree_List_Cons hd tl -> + let (i, x) = hd in + if i >= pivot + then Return (Betree_List_Nil, Betree_List_Cons (i, x) tl) + else + let* p = betree_ListTupleU64T_partition_at_pivot t tl pivot in + let (ls0, ls1) = p in + Return (Betree_List_Cons (i, x) ls0, ls1) + | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) + end + +(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: forward function + Source: 'src/betree.rs', lines 359:4-364:17 *) +let betree_Leaf_split + (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (st : state) : + result (state & betree_Internal_t) + = + let* p = betree_List_split_at (u64 & u64) content params.split_size in + let (content0, content1) = p in + let* p1 = betree_List_hd (u64 & u64) content1 in + let (pivot, _) = p1 in + let* id0 = betree_NodeIdCounter_fresh_id node_id_cnt in + let* node_id_cnt1 = betree_NodeIdCounter_fresh_id_back node_id_cnt in + let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt1 in + let* (st1, _) = betree_store_leaf_node id0 content0 st in + let* (st2, _) = betree_store_leaf_node id1 content1 st1 in + let n = Betree_Node_Leaf { id = id0; size = params.split_size } in + let n1 = Betree_Node_Leaf { id = id1; size = params.split_size } in + Return (st2, { id = self.id; pivot = pivot; left = n; right = n1 }) + +(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: backward function 2 + Source: 'src/betree.rs', lines 359:4-364:17 *) +let betree_Leaf_split_back + (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (st : state) : + result betree_NodeIdCounter_t + = + let* p = betree_List_split_at (u64 & u64) content params.split_size in + let (content0, content1) = p in + let* _ = betree_List_hd (u64 & u64) content1 in + let* id0 = betree_NodeIdCounter_fresh_id node_id_cnt in + let* node_id_cnt1 = betree_NodeIdCounter_fresh_id_back node_id_cnt in + let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt1 in + let* (st1, _) = betree_store_leaf_node id0 content0 st in + let* _ = betree_store_leaf_node id1 content1 st1 in + betree_NodeIdCounter_fresh_id_back node_id_cnt1 + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: forward function + Source: 'src/betree.rs', lines 789:4-792:34 *) +let rec betree_Node_lookup_first_message_for_key + (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_lookup_first_message_for_key_decreases key msgs)) + = + begin match msgs with + | Betree_List_Cons x next_msgs -> + let (i, m) = x in + if i >= key + then Return (Betree_List_Cons (i, m) next_msgs) + else betree_Node_lookup_first_message_for_key key next_msgs + | Betree_List_Nil -> Return Betree_List_Nil + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: backward function 0 + Source: 'src/betree.rs', lines 789:4-792:34 *) +let rec betree_Node_lookup_first_message_for_key_back + (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) + (ret : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_lookup_first_message_for_key_decreases key msgs)) + = + begin match msgs with + | Betree_List_Cons x next_msgs -> + let (i, m) = x in + if i >= key + then Return ret + else + let* next_msgs1 = + betree_Node_lookup_first_message_for_key_back key next_msgs ret in + Return (Betree_List_Cons (i, m) next_msgs1) + | Betree_List_Nil -> Return ret + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: forward function + Source: 'src/betree.rs', lines 636:4-636:80 *) +let rec betree_Node_lookup_in_bindings + (key : u64) (bindings : betree_List_t (u64 & u64)) : + Tot (result (option u64)) + (decreases (betree_Node_lookup_in_bindings_decreases key bindings)) + = + begin match bindings with + | Betree_List_Cons hd tl -> + let (i, i1) = hd in + if i = key + then Return (Some i1) + else if i > key then Return None else betree_Node_lookup_in_bindings key tl + | Betree_List_Nil -> Return None + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: forward function + Source: 'src/betree.rs', lines 819:4-819:90 *) +let rec betree_Node_apply_upserts + (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) + (key : u64) (st : state) : + Tot (result (state & u64)) + (decreases (betree_Node_apply_upserts_decreases msgs prev key st)) + = + let* b = betree_ListTupleU64T_head_has_key betree_Message_t msgs key in + if b + then + let* msg = betree_List_pop_front (u64 & betree_Message_t) msgs in + let (_, m) = msg in + begin match m with + | Betree_Message_Insert _ -> Fail Failure + | Betree_Message_Delete -> Fail Failure + | Betree_Message_Upsert s -> + let* v = betree_upsert_update prev s in + let* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in + betree_Node_apply_upserts msgs1 (Some v) key st + end + else + let* (st1, v) = core_option_Option_unwrap u64 prev st in + let* _ = + betree_List_push_front (u64 & betree_Message_t) msgs (key, + Betree_Message_Insert v) in + Return (st1, v) + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: backward function 0 + Source: 'src/betree.rs', lines 819:4-819:90 *) +let rec betree_Node_apply_upserts_back + (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) + (key : u64) (st : state) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_apply_upserts_decreases msgs prev key st)) + = + let* b = betree_ListTupleU64T_head_has_key betree_Message_t msgs key in + if b + then + let* msg = betree_List_pop_front (u64 & betree_Message_t) msgs in + let (_, m) = msg in + begin match m with + | Betree_Message_Insert _ -> Fail Failure + | Betree_Message_Delete -> Fail Failure + | Betree_Message_Upsert s -> + let* v = betree_upsert_update prev s in + let* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in + betree_Node_apply_upserts_back msgs1 (Some v) key st + end + else + let* (_, v) = core_option_Option_unwrap u64 prev st in + betree_List_push_front (u64 & betree_Message_t) msgs (key, + Betree_Message_Insert v) + +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: forward function + Source: 'src/betree.rs', lines 395:4-395:63 *) +let rec betree_Internal_lookup_in_children + (self : betree_Internal_t) (key : u64) (st : state) : + Tot (result (state & (option u64))) + (decreases (betree_Internal_lookup_in_children_decreases self key st)) + = + if key < self.pivot + then betree_Node_lookup self.left key st + else betree_Node_lookup self.right key st + +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: backward function 0 + Source: 'src/betree.rs', lines 395:4-395:63 *) +and betree_Internal_lookup_in_children_back + (self : betree_Internal_t) (key : u64) (st : state) : + Tot (result betree_Internal_t) + (decreases (betree_Internal_lookup_in_children_decreases self key st)) + = + if key < self.pivot + then + let* n = betree_Node_lookup_back self.left key st in + Return { self with left = n } + else + let* n = betree_Node_lookup_back self.right key st in + Return { self with right = n } + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: forward function + Source: 'src/betree.rs', lines 709:4-709:58 *) +and betree_Node_lookup + (self : betree_Node_t) (key : u64) (st : state) : + Tot (result (state & (option u64))) + (decreases (betree_Node_lookup_decreases self key st)) + = + begin match self with + | Betree_Node_Internal node -> + let* (st1, msgs) = betree_load_internal_node node.id st in + let* pending = betree_Node_lookup_first_message_for_key key msgs in + begin match pending with + | Betree_List_Cons p l -> + let (k, msg) = p in + if k <> key + then + let* (st2, o) = betree_Internal_lookup_in_children node key st1 in + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, msg) l) in + Return (st2, o) + else + begin match msg with + | Betree_Message_Insert v -> + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, Betree_Message_Insert v) l) in + Return (st1, Some v) + | Betree_Message_Delete -> + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, Betree_Message_Delete) l) in + Return (st1, None) + | Betree_Message_Upsert ufs -> + let* (st2, v) = betree_Internal_lookup_in_children node key st1 in + let* (st3, v1) = + betree_Node_apply_upserts (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st2 in + let* node1 = betree_Internal_lookup_in_children_back node key st1 in + let* pending1 = + betree_Node_apply_upserts_back (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st2 in + let* msgs1 = + betree_Node_lookup_first_message_for_key_back key msgs pending1 in + let* (st4, _) = betree_store_internal_node node1.id msgs1 st3 in + Return (st4, Some v1) + end + | Betree_List_Nil -> + let* (st2, o) = betree_Internal_lookup_in_children node key st1 in + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil + in + Return (st2, o) + end + | Betree_Node_Leaf node -> + let* (st1, bindings) = betree_load_leaf_node node.id st in + let* o = betree_Node_lookup_in_bindings key bindings in + Return (st1, o) + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: backward function 0 + Source: 'src/betree.rs', lines 709:4-709:58 *) +and betree_Node_lookup_back + (self : betree_Node_t) (key : u64) (st : state) : + Tot (result betree_Node_t) + (decreases (betree_Node_lookup_decreases self key st)) + = + begin match self with + | Betree_Node_Internal node -> + let* (st1, msgs) = betree_load_internal_node node.id st in + let* pending = betree_Node_lookup_first_message_for_key key msgs in + begin match pending with + | Betree_List_Cons p l -> + let (k, msg) = p in + if k <> key + then + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, msg) l) in + let* node1 = betree_Internal_lookup_in_children_back node key st1 in + Return (Betree_Node_Internal node1) + else + begin match msg with + | Betree_Message_Insert v -> + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, Betree_Message_Insert v) l) in + Return (Betree_Node_Internal node) + | Betree_Message_Delete -> + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs + (Betree_List_Cons (k, Betree_Message_Delete) l) in + Return (Betree_Node_Internal node) + | Betree_Message_Upsert ufs -> + let* (st2, v) = betree_Internal_lookup_in_children node key st1 in + let* (st3, _) = + betree_Node_apply_upserts (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st2 in + let* node1 = betree_Internal_lookup_in_children_back node key st1 in + let* pending1 = + betree_Node_apply_upserts_back (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st2 in + let* msgs1 = + betree_Node_lookup_first_message_for_key_back key msgs pending1 in + let* _ = betree_store_internal_node node1.id msgs1 st3 in + Return (Betree_Node_Internal node1) + end + | Betree_List_Nil -> + let* _ = + betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil + in + let* node1 = betree_Internal_lookup_in_children_back node key st1 in + Return (Betree_Node_Internal node1) + end + | Betree_Node_Leaf node -> + let* (_, bindings) = betree_load_leaf_node node.id st in + let* _ = betree_Node_lookup_in_bindings key bindings in + Return (Betree_Node_Leaf node) + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 674:4-674:77 *) +let rec betree_Node_filter_messages_for_key + (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_filter_messages_for_key_decreases key msgs)) + = + begin match msgs with + | Betree_List_Cons p l -> + let (k, m) = p in + if k = key + then + let* msgs1 = + betree_List_pop_front_back (u64 & betree_Message_t) (Betree_List_Cons + (k, m) l) in + betree_Node_filter_messages_for_key key msgs1 + else Return (Betree_List_Cons (k, m) l) + | Betree_List_Nil -> Return Betree_List_Nil + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: forward function + Source: 'src/betree.rs', lines 689:4-692:34 *) +let rec betree_Node_lookup_first_message_after_key + (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_lookup_first_message_after_key_decreases key msgs)) + = + begin match msgs with + | Betree_List_Cons p next_msgs -> + let (k, m) = p in + if k = key + then betree_Node_lookup_first_message_after_key key next_msgs + else Return (Betree_List_Cons (k, m) next_msgs) + | Betree_List_Nil -> Return Betree_List_Nil + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: backward function 0 + Source: 'src/betree.rs', lines 689:4-692:34 *) +let rec betree_Node_lookup_first_message_after_key_back + (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) + (ret : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_lookup_first_message_after_key_decreases key msgs)) + = + begin match msgs with + | Betree_List_Cons p next_msgs -> + let (k, m) = p in + if k = key + then + let* next_msgs1 = + betree_Node_lookup_first_message_after_key_back key next_msgs ret in + Return (Betree_List_Cons (k, m) next_msgs1) + else Return ret + | Betree_List_Nil -> Return ret + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 521:4-521:89 *) +let betree_Node_apply_to_internal + (msgs : betree_List_t (u64 & betree_Message_t)) (key : u64) + (new_msg : betree_Message_t) : + result (betree_List_t (u64 & betree_Message_t)) + = + let* msgs1 = betree_Node_lookup_first_message_for_key key msgs in + let* b = betree_ListTupleU64T_head_has_key betree_Message_t msgs1 key in + if b + then + begin match new_msg with + | Betree_Message_Insert i -> + let* msgs2 = betree_Node_filter_messages_for_key key msgs1 in + let* msgs3 = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, + Betree_Message_Insert i) in + betree_Node_lookup_first_message_for_key_back key msgs msgs3 + | Betree_Message_Delete -> + let* msgs2 = betree_Node_filter_messages_for_key key msgs1 in + let* msgs3 = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, + Betree_Message_Delete) in + betree_Node_lookup_first_message_for_key_back key msgs msgs3 + | Betree_Message_Upsert s -> + let* p = betree_List_hd (u64 & betree_Message_t) msgs1 in + let (_, m) = p in + begin match m with + | Betree_Message_Insert prev -> + let* v = betree_upsert_update (Some prev) s in + let* msgs2 = betree_List_pop_front_back (u64 & betree_Message_t) msgs1 + in + let* msgs3 = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, + Betree_Message_Insert v) in + betree_Node_lookup_first_message_for_key_back key msgs msgs3 + | Betree_Message_Delete -> + let* v = betree_upsert_update None s in + let* msgs2 = betree_List_pop_front_back (u64 & betree_Message_t) msgs1 + in + let* msgs3 = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, + Betree_Message_Insert v) in + betree_Node_lookup_first_message_for_key_back key msgs msgs3 + | Betree_Message_Upsert _ -> + let* msgs2 = betree_Node_lookup_first_message_after_key key msgs1 in + let* msgs3 = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, + Betree_Message_Upsert s) in + let* msgs4 = + betree_Node_lookup_first_message_after_key_back key msgs1 msgs3 in + betree_Node_lookup_first_message_for_key_back key msgs msgs4 + end + end + else + let* msgs2 = + betree_List_push_front (u64 & betree_Message_t) msgs1 (key, new_msg) in + betree_Node_lookup_first_message_for_key_back key msgs msgs2 + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 502:4-505:5 *) +let rec betree_Node_apply_messages_to_internal + (msgs : betree_List_t (u64 & betree_Message_t)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & betree_Message_t))) + (decreases (betree_Node_apply_messages_to_internal_decreases msgs new_msgs)) + = + begin match new_msgs with + | Betree_List_Cons new_msg new_msgs_tl -> + let (i, m) = new_msg in + let* msgs1 = betree_Node_apply_to_internal msgs i m in + betree_Node_apply_messages_to_internal msgs1 new_msgs_tl + | Betree_List_Nil -> Return msgs + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: forward function + Source: 'src/betree.rs', lines 653:4-656:32 *) +let rec betree_Node_lookup_mut_in_bindings + (key : u64) (bindings : betree_List_t (u64 & u64)) : + Tot (result (betree_List_t (u64 & u64))) + (decreases (betree_Node_lookup_mut_in_bindings_decreases key bindings)) + = + begin match bindings with + | Betree_List_Cons hd tl -> + let (i, i1) = hd in + if i >= key + then Return (Betree_List_Cons (i, i1) tl) + else betree_Node_lookup_mut_in_bindings key tl + | Betree_List_Nil -> Return Betree_List_Nil + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: backward function 0 + Source: 'src/betree.rs', lines 653:4-656:32 *) +let rec betree_Node_lookup_mut_in_bindings_back + (key : u64) (bindings : betree_List_t (u64 & u64)) + (ret : betree_List_t (u64 & u64)) : + Tot (result (betree_List_t (u64 & u64))) + (decreases (betree_Node_lookup_mut_in_bindings_decreases key bindings)) + = + begin match bindings with + | Betree_List_Cons hd tl -> + let (i, i1) = hd in + if i >= key + then Return ret + else + let* tl1 = betree_Node_lookup_mut_in_bindings_back key tl ret in + Return (Betree_List_Cons (i, i1) tl1) + | Betree_List_Nil -> Return ret + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 460:4-460:87 *) +let betree_Node_apply_to_leaf + (bindings : betree_List_t (u64 & u64)) (key : u64) + (new_msg : betree_Message_t) : + result (betree_List_t (u64 & u64)) + = + let* bindings1 = betree_Node_lookup_mut_in_bindings key bindings in + let* b = betree_ListTupleU64T_head_has_key u64 bindings1 key in + if b + then + let* hd = betree_List_pop_front (u64 & u64) bindings1 in + begin match new_msg with + | Betree_Message_Insert v -> + let* bindings2 = betree_List_pop_front_back (u64 & u64) bindings1 in + let* bindings3 = betree_List_push_front (u64 & u64) bindings2 (key, v) in + betree_Node_lookup_mut_in_bindings_back key bindings bindings3 + | Betree_Message_Delete -> + let* bindings2 = betree_List_pop_front_back (u64 & u64) bindings1 in + betree_Node_lookup_mut_in_bindings_back key bindings bindings2 + | Betree_Message_Upsert s -> + let (_, i) = hd in + let* v = betree_upsert_update (Some i) s in + let* bindings2 = betree_List_pop_front_back (u64 & u64) bindings1 in + let* bindings3 = betree_List_push_front (u64 & u64) bindings2 (key, v) in + betree_Node_lookup_mut_in_bindings_back key bindings bindings3 + end + else + begin match new_msg with + | Betree_Message_Insert v -> + let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in + betree_Node_lookup_mut_in_bindings_back key bindings bindings2 + | Betree_Message_Delete -> + betree_Node_lookup_mut_in_bindings_back key bindings bindings1 + | Betree_Message_Upsert s -> + let* v = betree_upsert_update None s in + let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in + betree_Node_lookup_mut_in_bindings_back key bindings bindings2 + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/betree.rs', lines 444:4-447:5 *) +let rec betree_Node_apply_messages_to_leaf + (bindings : betree_List_t (u64 & u64)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : + Tot (result (betree_List_t (u64 & u64))) + (decreases (betree_Node_apply_messages_to_leaf_decreases bindings new_msgs)) + = + begin match new_msgs with + | Betree_List_Cons new_msg new_msgs_tl -> + let (i, m) = new_msg in + let* bindings1 = betree_Node_apply_to_leaf bindings i m in + betree_Node_apply_messages_to_leaf bindings1 new_msgs_tl + | Betree_List_Nil -> Return bindings + end + +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: forward function + Source: 'src/betree.rs', lines 410:4-415:26 *) +let rec betree_Internal_flush + (self : betree_Internal_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 & betree_Message_t)) (st : state) : + Tot (result (state & (betree_List_t (u64 & betree_Message_t)))) + (decreases ( + betree_Internal_flush_decreases self params node_id_cnt content st)) + = + let* p = + betree_ListTupleU64T_partition_at_pivot betree_Message_t content self.pivot + in + let (msgs_left, msgs_right) = p in + let* len_left = betree_List_len (u64 & betree_Message_t) msgs_left in + if len_left >= params.min_flush_size + then + let* (st1, _) = + betree_Node_apply_messages self.left params node_id_cnt msgs_left st in + let* (_, node_id_cnt1) = + betree_Node_apply_messages_back self.left params node_id_cnt msgs_left st + in + let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in + if len_right >= params.min_flush_size + then + let* (st2, _) = + betree_Node_apply_messages self.right params node_id_cnt1 msgs_right + st1 in + let* _ = + betree_Node_apply_messages_back self.right params node_id_cnt1 + msgs_right st1 in + Return (st2, Betree_List_Nil) + else Return (st1, msgs_right) + else + let* (st1, _) = + betree_Node_apply_messages self.right params node_id_cnt msgs_right st in + let* _ = + betree_Node_apply_messages_back self.right params node_id_cnt msgs_right + st in + Return (st1, msgs_left) + +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: backward function 0 + Source: 'src/betree.rs', lines 410:4-415:26 *) +and betree_Internal_flush_back + (self : betree_Internal_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 & betree_Message_t)) (st : state) : + Tot (result (betree_Internal_t & betree_NodeIdCounter_t)) + (decreases ( + betree_Internal_flush_decreases self params node_id_cnt content st)) + = + let* p = + betree_ListTupleU64T_partition_at_pivot betree_Message_t content self.pivot + in + let (msgs_left, msgs_right) = p in + let* len_left = betree_List_len (u64 & betree_Message_t) msgs_left in + if len_left >= params.min_flush_size + then + let* (st1, _) = + betree_Node_apply_messages self.left params node_id_cnt msgs_left st in + let* (n, node_id_cnt1) = + betree_Node_apply_messages_back self.left params node_id_cnt msgs_left st + in + let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in + if len_right >= params.min_flush_size + then + let* (n1, node_id_cnt2) = + betree_Node_apply_messages_back self.right params node_id_cnt1 + msgs_right st1 in + Return ({ self with left = n; right = n1 }, node_id_cnt2) + else Return ({ self with left = n }, node_id_cnt1) + else + let* (n, node_id_cnt1) = + betree_Node_apply_messages_back self.right params node_id_cnt msgs_right + st in + Return ({ self with right = n }, node_id_cnt1) + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: forward function + Source: 'src/betree.rs', lines 588:4-593:5 *) +and betree_Node_apply_messages + (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : + Tot (result (state & unit)) + (decreases ( + betree_Node_apply_messages_decreases self params node_id_cnt msgs st)) + = + begin match self with + | Betree_Node_Internal node -> + let* (st1, content) = betree_load_internal_node node.id st in + let* content1 = betree_Node_apply_messages_to_internal content msgs in + let* num_msgs = betree_List_len (u64 & betree_Message_t) content1 in + if num_msgs >= params.min_flush_size + then + let* (st2, content2) = + betree_Internal_flush node params node_id_cnt content1 st1 in + let* (node1, _) = + betree_Internal_flush_back node params node_id_cnt content1 st1 in + let* (st3, _) = betree_store_internal_node node1.id content2 st2 in + Return (st3, ()) + else + let* (st2, _) = betree_store_internal_node node.id content1 st1 in + Return (st2, ()) + | Betree_Node_Leaf node -> + let* (st1, content) = betree_load_leaf_node node.id st in + let* content1 = betree_Node_apply_messages_to_leaf content msgs in + let* len = betree_List_len (u64 & u64) content1 in + let* i = u64_mul 2 params.split_size in + if len >= i + then + let* (st2, _) = betree_Leaf_split node content1 params node_id_cnt st1 in + let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in + Return (st3, ()) + else + let* (st2, _) = betree_store_leaf_node node.id content1 st1 in + Return (st2, ()) + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: backward function 0 + Source: 'src/betree.rs', lines 588:4-593:5 *) +and betree_Node_apply_messages_back + (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : + Tot (result (betree_Node_t & betree_NodeIdCounter_t)) + (decreases ( + betree_Node_apply_messages_decreases self params node_id_cnt msgs st)) + = + begin match self with + | Betree_Node_Internal node -> + let* (st1, content) = betree_load_internal_node node.id st in + let* content1 = betree_Node_apply_messages_to_internal content msgs in + let* num_msgs = betree_List_len (u64 & betree_Message_t) content1 in + if num_msgs >= params.min_flush_size + then + let* (st2, content2) = + betree_Internal_flush node params node_id_cnt content1 st1 in + let* (node1, node_id_cnt1) = + betree_Internal_flush_back node params node_id_cnt content1 st1 in + let* _ = betree_store_internal_node node1.id content2 st2 in + Return (Betree_Node_Internal node1, node_id_cnt1) + else + let* _ = betree_store_internal_node node.id content1 st1 in + Return (Betree_Node_Internal node, node_id_cnt) + | Betree_Node_Leaf node -> + let* (st1, content) = betree_load_leaf_node node.id st in + let* content1 = betree_Node_apply_messages_to_leaf content msgs in + let* len = betree_List_len (u64 & u64) content1 in + let* i = u64_mul 2 params.split_size in + if len >= i + then + let* (st2, new_node) = + betree_Leaf_split node content1 params node_id_cnt st1 in + let* _ = betree_store_leaf_node node.id Betree_List_Nil st2 in + let* node_id_cnt1 = + betree_Leaf_split_back node content1 params node_id_cnt st1 in + Return (Betree_Node_Internal new_node, node_id_cnt1) + else + let* _ = betree_store_leaf_node node.id content1 st1 in + Return (Betree_Node_Leaf { node with size = len }, node_id_cnt) + end + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: forward function + Source: 'src/betree.rs', lines 576:4-582:5 *) +let betree_Node_apply + (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) (key : u64) + (new_msg : betree_Message_t) (st : state) : + result (state & unit) + = + let* (st1, _) = + betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, + new_msg) Betree_List_Nil) st in + let* _ = + betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons + (key, new_msg) Betree_List_Nil) st in + Return (st1, ()) + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: backward function 0 + Source: 'src/betree.rs', lines 576:4-582:5 *) +let betree_Node_apply_back + (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) (key : u64) + (new_msg : betree_Message_t) (st : state) : + result (betree_Node_t & betree_NodeIdCounter_t) + = + betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons + (key, new_msg) Betree_List_Nil) st + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: forward function + Source: 'src/betree.rs', lines 849:4-849:60 *) +let betree_BeTree_new + (min_flush_size : u64) (split_size : u64) (st : state) : + result (state & betree_BeTree_t) + = + let* node_id_cnt = betree_NodeIdCounter_new in + let* id = betree_NodeIdCounter_fresh_id node_id_cnt in + let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in + let* node_id_cnt1 = betree_NodeIdCounter_fresh_id_back node_id_cnt in + Return (st1, + { + params = { min_flush_size = min_flush_size; split_size = split_size }; + node_id_cnt = node_id_cnt1; + root = (Betree_Node_Leaf { id = id; size = 0 }) + }) + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: forward function + Source: 'src/betree.rs', lines 868:4-868:47 *) +let betree_BeTree_apply + (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : + result (state & unit) + = + let* (st1, _) = + betree_Node_apply self.root self.params self.node_id_cnt key msg st in + let* _ = + betree_Node_apply_back self.root self.params self.node_id_cnt key msg st in + Return (st1, ()) + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: backward function 0 + Source: 'src/betree.rs', lines 868:4-868:47 *) +let betree_BeTree_apply_back + (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : + result betree_BeTree_t + = + let* (n, nic) = + betree_Node_apply_back self.root self.params self.node_id_cnt key msg st in + Return { self with node_id_cnt = nic; root = n } + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: forward function + Source: 'src/betree.rs', lines 874:4-874:52 *) +let betree_BeTree_insert + (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : + result (state & unit) + = + let* (st1, _) = betree_BeTree_apply self key (Betree_Message_Insert value) st + in + let* _ = betree_BeTree_apply_back self key (Betree_Message_Insert value) st + in + Return (st1, ()) + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: backward function 0 + Source: 'src/betree.rs', lines 874:4-874:52 *) +let betree_BeTree_insert_back + (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : + result betree_BeTree_t + = + betree_BeTree_apply_back self key (Betree_Message_Insert value) st + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: forward function + Source: 'src/betree.rs', lines 880:4-880:38 *) +let betree_BeTree_delete + (self : betree_BeTree_t) (key : u64) (st : state) : result (state & unit) = + let* (st1, _) = betree_BeTree_apply self key Betree_Message_Delete st in + let* _ = betree_BeTree_apply_back self key Betree_Message_Delete st in + Return (st1, ()) + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: backward function 0 + Source: 'src/betree.rs', lines 880:4-880:38 *) +let betree_BeTree_delete_back + (self : betree_BeTree_t) (key : u64) (st : state) : result betree_BeTree_t = + betree_BeTree_apply_back self key Betree_Message_Delete st + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: forward function + Source: 'src/betree.rs', lines 886:4-886:59 *) +let betree_BeTree_upsert + (self : betree_BeTree_t) (key : u64) (upd : betree_UpsertFunState_t) + (st : state) : + result (state & unit) + = + let* (st1, _) = betree_BeTree_apply self key (Betree_Message_Upsert upd) st + in + let* _ = betree_BeTree_apply_back self key (Betree_Message_Upsert upd) st in + Return (st1, ()) + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: backward function 0 + Source: 'src/betree.rs', lines 886:4-886:59 *) +let betree_BeTree_upsert_back + (self : betree_BeTree_t) (key : u64) (upd : betree_UpsertFunState_t) + (st : state) : + result betree_BeTree_t + = + betree_BeTree_apply_back self key (Betree_Message_Upsert upd) st + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: forward function + Source: 'src/betree.rs', lines 895:4-895:62 *) +let betree_BeTree_lookup + (self : betree_BeTree_t) (key : u64) (st : state) : + result (state & (option u64)) + = + betree_Node_lookup self.root key st + +(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: backward function 0 + Source: 'src/betree.rs', lines 895:4-895:62 *) +let betree_BeTree_lookup_back + (self : betree_BeTree_t) (key : u64) (st : state) : result betree_BeTree_t = + let* n = betree_Node_lookup_back self.root key st in + Return { self with root = n } + +(** [betree_main::main]: forward function + Source: 'src/betree_main.rs', lines 5:0-5:9 *) +let main : result unit = + Return () + +(** Unit test for [betree_main::main] *) +let _ = assert_norm (main = Return ()) + |